@@ -12,15 +12,28 @@ module Main (main) where
1212import Control.DeepSeq (NFData(..))
1313import Data.Monoid (Last(..), Sum(..))
1414import System.Random (randomRIO)
15+import Prelude (IO, Int, Double, String, (>), (<$>), (+), ($), even,
16+ (<=), Monad(..), (==), Maybe(..), (.), fromIntegral,
17+ compare, (>=), concat, seq, mod, fst, snd, const, Bool, Ord(..),
18+ div, Num(..), odd, Either(..))
1519
16−import qualified Streamly.Data.Array.Storable.Foreign as A
17−import qualified Streamly.Data.Fold as FL
18−import qualified Streamly.Internal.Data.Array.Storable.Foreign as IA
19−import qualified Streamly.Internal.Data.Fold as IFL
20+import Data.Map.Strict (Map)
21+
22+import Streamly.Prelude (SerialT)
23+import Streamly.Internal.Data.Fold (Fold(..))
24+
25+import qualified Data.Map.Strict as Map
26+
27+import qualified Streamly.Prelude as S
28+import qualified Streamly.Internal.Data.Fold as FL
29+import qualified Streamly.Internal.Data.Fold.Types as FL
2030import qualified Streamly.Internal.Data.Pipe as Pipe
31+
2132import qualified Streamly.Internal.Data.Sink as Sink
33+
34+import qualified Streamly.Data.Array.Storable.Foreign as A
35+import qualified Streamly.Internal.Data.Array.Storable.Foreign as IA
2236import qualified Streamly.Internal.Data.Stream.IsStream as IP
23−import qualified Streamly.Prelude as S
2437
2538import Gauge
2639import Streamly.Benchmark.Common
@@ -49,7 +62,110 @@ benchIOSink
4962benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
5063
5164-------------------------------------------------------------------------------
52−-- Stream folds
65+-- Folds
66+-------------------------------------------------------------------------------
67+
68+{-# INLINE any #-}
69+any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
70+any value = IP.fold (FL.any (> value))
71+
72+{-# INLINE all #-}
73+all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
74+all value = IP.fold (FL.all (<= value))
75+
76+{-# INLINE take #-}
77+take :: Monad m => Int -> SerialT m a -> m ()
78+take value = IP.fold (FL.ltake value FL.drain)
79+
80+{-# INLINE takeSepBy #-}
81+takeSepBy :: Monad m => Int -> SerialT m Int -> m ()
82+takeSepBy value = IP.fold (FL.takeSepBy (<= value) FL.drain)
83+
84+{-# INLINE many #-}
85+many :: Monad m => SerialT m Int -> m Int
86+many = IP.fold (FL.many FL.length FL.sum)
87+
88+{-# INLINE splitAllAny #-}
89+splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)
90+splitAllAny value =
91+ IP.fold (FL.splitWith (,) (FL.all (<= (value `div` 2))) (FL.any (> value)))
92+
93+{-# INLINE teeAllAny #-}
94+teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)
95+teeAllAny value =
96+ IP.fold (FL.teeWith (,) (FL.all (<= value)) (FL.any (> value)))
97+
98+{-# INLINE teeSumLength #-}
99+teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
100+teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)
101+
102+{-
103+{-# INLINE applicativeAllAny #-}
104+applicativeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)
105+applicativeAllAny value =
106+ IP.fold ((,) <$> FL.all (<= value) <*> (FL.any (> value)))
107+
108+{-# INLINE applicativeSumLength #-}
109+applicativeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
110+applicativeSumLength = IP.fold ((,) <$> FL.sum <*> FL.length)
111+-}
112+
113+{-# INLINE distribute_ #-}
114+distribute_ :: Monad m => SerialT m Int -> m ()
115+distribute_ =
116+ IP.fold (FL.distribute_ [const () <$> FL.sum, const () <$> FL.length])
117+
118+{-# INLINE distribute #-}
119+distribute :: Monad m => SerialT m Int -> m [Int]
120+distribute = IP.fold (FL.distribute [FL.sum, FL.length])
121+
122+{-# INLINE partition #-}
123+partition :: Monad m => SerialT m Int -> m (Int, Int)
124+partition =
125+ let f a =
126+ if odd a
127+ then Left a
128+ else Right a
129+ in IP.fold $ FL.lmap f (FL.partition FL.sum FL.length)
130+
131+{-# INLINE unzip #-}
132+unzip :: Monad m => SerialT m Int -> m (Int, Int)
133+unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
134+
135+{-# INLINE demuxWith #-}
136+demuxWith ::
137+ (Monad m, Ord k)
138+ => (a -> (k, a'))
139+ -> Map k (Fold m a' b)
140+ -> SerialT m a
141+ -> m (Map k b)
142+demuxWith f mp = S.fold (FL.demuxWith f mp)
143+
144+{-# INLINE demuxWith_ #-}
145+demuxWith_ ::
146+ (Monad m, Ord k)
147+ => (a -> (k, a'))
148+ -> Map k (Fold m a' b)
149+ -> SerialT m a
150+ -> m ()
151+demuxWith_ f mp = S.fold (FL.demuxWith_ f mp)
152+
153+{-# INLINE demuxWithDefault_ #-}
154+demuxWithDefault_ ::
155+ (Monad m, Ord k, Num b)
156+ => (a -> (k, b))
157+ -> Map k (Fold m b b)
158+ -> SerialT m a
159+ -> m ()
160+demuxWithDefault_ f mp = S.fold (FL.demuxWithDefault_ f mp (FL.lmap snd FL.sum))
161+
162+{-# INLINE classifyWith #-}
163+classifyWith ::
164+ (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)
165+classifyWith f = S.fold (FL.classifyWith f FL.sum)
166+
167+-------------------------------------------------------------------------------
168+-- Benchmarks
53169-------------------------------------------------------------------------------
54170
55171moduleName :: String
@@ -61,15 +177,15 @@ o_1_space_serial_elimination value =
61177 [ bgroup "elimination"
62178 [ benchIOSink value "drain" (S.fold FL.drain)
63179 , benchIOSink value "drainBy" (S.fold (FL.drainBy return))
64− , benchIOSink value "drainN" (S.fold (IFL.drainN value))
180+ , benchIOSink value "drainN" (S.fold (FL.drainN value))
65181 , benchIOSink
66182 value
67− "drainWhileTrue"
68− (S.fold (IFL.drainWhile $ (<=) (value + 1)))
183+ "drainSepByTrue"
184+ (S.fold (FL.drainSepBy $ (<=) (value + 1)))
69185 , benchIOSink
70186 value
71− "drainWhileFalse"
72− (S.fold (IFL.drainWhile $ (>=) (value + 1)))
187+ "drainSepByFalse"
188+ (S.fold (FL.drainSepBy $ (>=) (value + 1)))
73189 , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
74190 , benchIOSink value "last" (S.fold FL.last)
75191 , benchIOSink value "lastN.1" (S.fold (IA.lastN 1))
@@ -121,7 +237,7 @@ o_1_space_serial_elimination value =
121237 , benchIOSink
122238 value
123239 "lookup"
124− (S.fold (IFL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
240+ (S.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
125241 , benchIOSink
126242 value
127243 "findIndex"
@@ -133,8 +249,10 @@ o_1_space_serial_elimination value =
133249 , benchIOSink value "null" (S.fold FL.null)
134250 , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
135251 , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
136− , benchIOSink value "all" (S.fold (FL.all (<= (value + 1))))
137− , benchIOSink value "any" (S.fold (FL.any (> (value + 1))))
252+ , benchIOSink value "all" $ all value
253+ , benchIOSink value "any" $ any value
254+ , benchIOSink value "take" $ take value
255+ , benchIOSink value "takeSepBy" $ takeSepBy value
138256 , benchIOSink
139257 value
140258 "and"
@@ -152,9 +270,9 @@ o_1_space_serial_transformation :: Int -> [Benchmark]
152270o_1_space_serial_transformation value =
153271 [ bgroup "serially"
154272 [ bgroup "transformation"
155− [ benchIOSink value "lmap" (S.fold (IFL.lmap (+ 1) FL.drain))
273+ [ benchIOSink value "lmap" (S.fold (FL.lmap (+ 1) FL.drain))
156274 , let f x = if even x then Just x else Nothing
157− fld = IFL.mapMaybe f FL.drain
275+ fld = FL.mapMaybe f FL.drain
158276 in benchIOSink value "mapMaybe" (S.fold fld)
159277 , benchIOSink
160278 value
@@ -165,7 +283,7 @@ o_1_space_serial_transformation value =
165283 value
166284 "pipe-mapM"
167285 (S.fold
168− (IFL.transform
286+ (FL.transform
169287 (Pipe.mapM (\x -> return $ x + 1))
170288 FL.drain))
171289 ]
@@ -174,40 +292,39 @@ o_1_space_serial_transformation value =
174292
175293o_1_space_serial_composition :: Int -> [Benchmark]
176294o_1_space_serial_composition value =
177− [ bgroup "serially"
178− [ bgroup "composition" -- Applicative
179− [ benchIOSink
180− value
181− "all,any"
182− (S.fold
183− ((,) <$> FL.all (<= (value + 1)) <*>
184− FL.any (> (value + 1))))
185− , benchIOSink
186− value
187− "sum,length"
188− (S.fold ((,) <$> FL.sum <*> FL.length))
189− , benchIOSink
190− value
191− "tee sum length"
192− (S.fold (FL.tee FL.sum FL.length))
193− , benchIOSink
194− value
195− "distribute sum length"
196− (S.fold (FL.distribute [FL.sum, FL.length]))
197− , benchIOSink
198− value
199− "partition sum length"
200− (S.fold (IFL.lmap
201− (\a -> if odd a then Left a else Right a)
202− (FL.partition FL.sum FL.length)))
203− , benchIOSink
204− value
205− "unzip sum length"
206− (S.fold (IFL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)))
207− ]
208− ]
295+ [ bgroup
296+ "serially"
297+ [ bgroup
298+ "composition"
299+ -- Applicative
300+ [ benchIOSink value "tee (all, any)" $ teeAllAny value
301+ , benchIOSink value "tee (sum, length)" $ teeSumLength
302+ -- , benchIOSink value "applicative (all, any)"
303+ -- $ applicativeAllAny value
304+ -- , benchIOSink value "applicative (sum, length)"
305+ -- $ applicativeSumLength
306+ , benchIOSink value "distribute_ [sum, length]" $ distribute_
307+ , benchIOSink value "distribute [sum, length]" $ distribute
308+ , benchIOSink value "partition (sum, length)" $ partition
309+ , benchIOSink value "unzip (sum, length)" $ unzip
310+ , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
311+ , benchIOSink value "demuxWith_ [sum, length]"
312+ $ demuxWith_ fn mp
313+ , benchIOSink value "demuxWithDefault_ [sum, length] sum"
314+ $ demuxWithDefault_ fn mp
315+ , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)
316+ , benchIOSink value "many length sum" many
317+ , benchIOSink value "split (all, any)" $ splitAllAny value
318+ ]
319+ ]
209320 ]
210321
322+ where
323+
324+ fn x = (x `mod` 3, x)
325+
326+ mp = Map.fromList [(0, FL.sum), (1, FL.length)]
327+
211328o_n_heap_serial :: Int -> [Benchmark]
212329o_n_heap_serial value =
213330 [ bgroup "serially"
@@ -217,7 +334,7 @@ o_n_heap_serial value =
217334 [ benchIOSink value "toStream" (S.fold IP.toStream)
218335 , benchIOSink value "toStreamRev" (S.fold IP.toStreamRev)
219336 , benchIOSink value "toList" (S.fold FL.toList)
220− , benchIOSink value "toListRevF" (S.fold IFL.toListRevF)
337+ , benchIOSink value "toListRevF" (S.fold FL.toListRevF)
221338 -- Converting the stream to an array
222339 , benchIOSink value "lastN.Max" (S.fold (IA.lastN (value + 1)))
223340 , benchIOSink value "writeN" (S.fold (A.writeN value))