git.iko.soy/streamly
on master help sign in
Fix/enhance benchmarks for concatPairsWith
68317a4Harendra Kumar
.hlint.ignore+1−1
compare with master
unifiedsplit
@@ -42,6 +42,7 @@ benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
42benchmark/Streamly/Benchmark/Data/Unfold.hs
42benchmark/Streamly/Benchmark/Data/Unfold.hs
43benchmark/Streamly/Benchmark/FileSystem/Handle.hs
43benchmark/Streamly/Benchmark/FileSystem/Handle.hs
44benchmark/Streamly/Benchmark/Prelude/Async.hs
44benchmark/Streamly/Benchmark/Prelude/Async.hs
45+benchmark/Streamly/Benchmark/Prelude/Merge.hs
45benchmark/Streamly/Benchmark/Prelude/Parallel.hs
46benchmark/Streamly/Benchmark/Prelude/Parallel.hs
46benchmark/Streamly/Benchmark/Prelude/Rate.hs
47benchmark/Streamly/Benchmark/Prelude/Rate.hs
47benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
48benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
@@ -50,4 +51,3 @@ benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs
50benchmark/Streamly/Benchmark/Prelude/Serial/Transformation1.hs
51benchmark/Streamly/Benchmark/Prelude/Serial/Transformation1.hs
51benchmark/Streamly/Benchmark/Prelude/WAsync.hs
52benchmark/Streamly/Benchmark/Prelude/WAsync.hs
52benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
53benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
53−benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+9
@@ -384,6 +384,14 @@ iterateDropWhileTrue streamLen iterStreamLen =
384zipWith :: Monad m => Stream m Int -> m ()
384zipWith :: Monad m => Stream m Int -> m ()
385zipWith src = drain $ S.zipWith (,) src src
385zipWith src = drain $ S.zipWith (,) src src
386
386
387+{-# INLINE sortByK #-}
388+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
389+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
390+
391+{-# INLINE sortBy #-}
392+sortBy :: Monad m => Stream m Int -> m ()
393+sortBy = drain . sortByK compare
394+
387-------------------------------------------------------------------------------
395-------------------------------------------------------------------------------
388-- Mixed Composition
396-- Mixed Composition
389-------------------------------------------------------------------------------
397-------------------------------------------------------------------------------
@@ -700,6 +708,7 @@ o_1_space_concat streamLen =
700 (concatMapBySerial streamLen2 streamLen2)
708 (concatMapBySerial streamLen2 streamLen2)
701 , benchIOSrc1 "concatMapBy serial (1 of n)"
709 , benchIOSrc1 "concatMapBy serial (1 of n)"
702 (concatMapBySerial 1 streamLen)
710 (concatMapBySerial 1 streamLen)
711+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
703 ]
712 ]
704 where
713 where
705 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
714 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
benchmark/Streamly/Benchmark/Prelude/Merge.hsnew file+270
@@ -0,0 +1,270 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE BangPatterns #-}
9+{-# LANGUAGE CPP #-}
10+{-# LANGUAGE FlexibleContexts #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE RankNTypes #-}
13+
14+#ifdef __HADDOCK_VERSION__
15+#undef INSPECTION
16+#endif
17+
18+#ifdef INSPECTION
19+{-# LANGUAGE TemplateHaskell #-}
20+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21+#endif
22+
23+import Streamly.Internal.Data.Stream.IsStream (SerialT)
24+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
25+-- import qualified Streamly.Internal.Data.Unfold as Unfold
26+
27+import Streamly.Benchmark.Common
28+import Streamly.Benchmark.Prelude
29+
30+import Gauge
31+
32+#ifdef INSPECTION
33+import GHC.Types (SPEC(..))
34+import Test.Inspection
35+
36+import qualified Streamly.Internal.Data.Stream.StreamD as D
37+#endif
38+
39+moduleName :: String
40+moduleName = "Prelude.Merge"
41+
42+-------------------------------------------------------------------------------
43+-- Merging
44+-------------------------------------------------------------------------------
45+
46+{-# INLINE mergeWith #-}
47+mergeWith ::
48+ ( (Int -> Int -> Ordering)
49+ -> SerialT IO Int
50+ -> SerialT IO Int
51+ -> SerialT IO Int
52+ )
53+ -> (Int -> Int -> Ordering)
54+ -> Int -> Int -> IO ()
55+mergeWith g cmp count n =
56+ Stream.drain
57+ $ g
58+ cmp
59+ (sourceUnfoldrM count n)
60+ (sourceUnfoldrM count (n + 1))
61+
62+{-# INLINE mergeWithM #-}
63+mergeWithM ::
64+ ( (Int -> Int -> IO Ordering)
65+ -> SerialT IO Int
66+ -> SerialT IO Int
67+ -> SerialT IO Int
68+ )
69+ -> (Int -> Int -> Ordering)
70+ -> Int -> Int -> IO ()
71+mergeWithM g cmp count n =
72+ Stream.drain
73+ $ g
74+ (\a b -> return $ cmp a b)
75+ (sourceUnfoldrM count n)
76+ (sourceUnfoldrM count (n + 1))
77+
78+{-# INLINE mergeBy #-}
79+mergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
80+mergeBy = mergeWith Stream.mergeBy
81+
82+{-# INLINE mergeByM #-}
83+mergeByM :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
84+mergeByM = mergeWithM Stream.mergeByM
85+
86+{-# INLINE mergeByMFused #-}
87+mergeByMFused :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
88+mergeByMFused = mergeWithM Stream.mergeByMFused
89+
90+#ifdef INSPECTION
91+inspect $ hasNoTypeClasses 'mergeBy
92+inspect $ 'mergeBy `hasNoType` ''SPEC
93+inspect $ 'mergeBy `hasNoType` ''D.Step
94+
95+inspect $ hasNoTypeClasses 'mergeByM
96+inspect $ 'mergeByM `hasNoType` ''SPEC
97+inspect $ 'mergeByM `hasNoType` ''D.Step
98+
99+{-# INLINE _mergeByMFusedCheck #-}
100+_mergeByMFusedCheck :: IO ()
101+_mergeByMFusedCheck = mergeWithM Stream.mergeByMFused compare 0 0
102+
103+inspect $ hasNoTypeClasses '_mergeByMFusedCheck
104+inspect $ '_mergeByMFusedCheck `hasNoType` ''SPEC
105+inspect $ '_mergeByMFusedCheck `hasNoType` ''D.Step
106+#endif
107+
108+{-# INLINE concatPairsWithMergeBy #-}
109+concatPairsWithMergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
110+concatPairsWithMergeBy cmp = concatPairsWith (Stream.mergeBy cmp)
111+
112+{-# INLINE concatPairsWithMergeByFused #-}
113+concatPairsWithMergeByFused ::
114+ (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
115+concatPairsWithMergeByFused cmp =
116+ concatPairsWith (Stream.mergeByMFused (\x y -> return $ cmp x y))
117+
118+-------------------------------------------------------------------------------
119+-- Interleaving
120+-------------------------------------------------------------------------------
121+
122+o_1_space_joining :: Int -> [Benchmark]
123+o_1_space_joining value =
124+ [ bgroup "joining (2 of n/2)"
125+ [ benchIOSrc1
126+ "mergeBy compare"
127+ (mergeBy compare (value `div` 2))
128+ , benchIOSrc1
129+ "mergeByM compare"
130+ (mergeByM compare (value `div` 2))
131+ , benchIOSrc1
132+ "mergeByMFused compare"
133+ (mergeByMFused compare (value `div` 2))
134+
135+ , benchIOSrc1
136+ "mergeBy (flip compare)"
137+ (mergeBy (flip compare) (value `div` 2))
138+ , benchIOSrc1
139+ "mergeByM (flip compare)"
140+ (mergeByM (flip compare) (value `div` 2))
141+ , benchIOSrc1
142+ "mergeByMFused (flip compare)"
143+ (mergeByMFused (flip compare) (value `div` 2))
144+
145+ , benchIOSrc1
146+ "concatPairsWithMergeBy compare"
147+ (concatPairsWithMergeBy compare 2 (value `div` 2))
148+ , benchIOSrc1
149+ "concatPairsWithMergeBy (flip compare)"
150+ (concatPairsWithMergeBy (flip compare) 2 (value `div` 2))
151+
152+ , benchIOSrc1
153+ "concatPairsWithMergeByFused compare"
154+ (concatPairsWithMergeByFused compare 2 (value `div` 2))
155+ , benchIOSrc1
156+ "concatPairsWithMergeByFused (flip compare)"
157+ (concatPairsWithMergeByFused (flip compare) 2 (value `div` 2))
158+ ]
159+ ]
160+
161+-------------------------------------------------------------------------------
162+-- Concat
163+-------------------------------------------------------------------------------
164+
165+{-
166+{-# INLINE sourceUnfoldrMUF #-}
167+-- (count, value)
168+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int
169+sourceUnfoldrMUF count = UF.unfoldrM step
170+ where
171+ step (cnt, start) =
172+ return $
173+ if cnt > start + count
174+ then Nothing
175+ else Just (cnt, (cnt + 1, start))
176+
177+{-# INLINE unfoldManyMergeBy #-}
178+unfoldManyMergeBy :: Int -> Int -> Int -> IO ()
179+unfoldManyMergeBy outer inner n =
180+ S.drain $ (Internal.unfoldManyMergeBy compare)
181+ -- (UF.lmap return (UF.replicateM inner))
182+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
183+ (sourceUnfoldrM outer n)
184+
185+#ifdef INSPECTION
186+inspect $ hasNoTypeClasses 'unfoldManyMergeBy
187+-- inspect $ 'unfoldManyMergeBy `hasNoType` ''SPEC
188+-- inspect $ 'unfoldManyMergeBy `hasNoType`
189+-- ''D.ConcatUnfoldMergeState
190+#endif
191+-}
192+
193+{-# INLINE sortBy #-}
194+sortBy :: (Int -> Int -> Ordering) -> SerialT IO Int -> IO ()
195+sortBy cmp = Stream.drain . Stream.sortBy cmp
196+
197+-- For fair comparison with concatPairs, removed sorted segmentation
198+{-# INLINE listSortBy #-}
199+listSortBy :: (a -> a -> Ordering) -> [a] -> [a]
200+listSortBy cmp = mergeAll . sequences
201+ where
202+ sequences = fmap (: [])
203+
204+ mergeAll [x] = x
205+ mergeAll xs = mergeAll (mergePairs xs)
206+
207+ mergePairs (a:b:xs) = let !x = merge a b
208+ in x : mergePairs xs
209+ mergePairs xs = xs
210+
211+ merge as@(a:as') bs@(b:bs')
212+ | a `cmp` b == GT = b:merge as bs'
213+ | otherwise = a:merge as' bs
214+ merge [] bs = bs
215+ merge as [] = as
216+
217+o_n_heap_concat :: Int -> [Benchmark]
218+o_n_heap_concat value =
219+ [ bgroup "concatPairsWith"
220+ [ benchIOSrc1
221+ "concatPairsWithMergeBy compare (n of 1)"
222+ (concatPairsWithMergeBy compare value 1)
223+ , benchIOSrc1
224+ "concatPairsWithMergeBy compare (sqrtVal of sqrtVal)"
225+ (concatPairsWithMergeBy compare sqrtVal sqrtVal)
226+
227+ , benchIOSrc1
228+ "concatPairsWithMergeBy (flip compare) (n of 1)"
229+ (concatPairsWithMergeBy (flip compare) value 1)
230+ , benchIOSrc1
231+ "concatPairsWithMergeBy (flip compare) (sqrtVal of sqrtVal)"
232+ (concatPairsWithMergeBy (flip compare) sqrtVal sqrtVal)
233+
234+ , benchIOSrc1
235+ "concatPairsWithMergeByFused compare (n of 1)"
236+ (concatPairsWithMergeByFused compare value 1)
237+ , benchIOSrc1
238+ "concatPairsWithMergeByFused compare (sqrtVal of sqrtVal)"
239+ (concatPairsWithMergeByFused compare sqrtVal sqrtVal)
240+ ]
241+ , bgroup "sorting"
242+ [ benchIOSink value "sortBy compare" (sortBy compare)
243+ , benchIOSink value "sortBy (flip compare)" (sortBy (flip compare))
244+ , bench "sortByLists compare"
245+ $ nf (\x -> listSortBy compare [1..x]) value
246+ , bench "sortByLists (flip compare)"
247+ $ nf (\x -> listSortBy (flip compare) [1..x]) value
248+ ]
249+ ]
250+
251+ where
252+
253+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
254+
255+-------------------------------------------------------------------------------
256+-- Main
257+-------------------------------------------------------------------------------
258+
259+-- In addition to gauge options, the number of elements in the stream can be
260+-- passed using the --stream-size option.
261+--
262+main :: IO ()
263+main = runWithCLIOpts defaultStreamSize allBenchmarks
264+
265+ where
266+
267+ allBenchmarks size =
268+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_joining size)
269+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
270+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs+16−71
@@ -125,38 +125,6 @@ inspect $ 'append2 `hasNoType` ''SPEC
125inspect $ 'append2 `hasNoType` ''D.AppendState
125inspect $ 'append2 `hasNoType` ''D.AppendState
126#endif
126#endif
127
127
128−-------------------------------------------------------------------------------
129−-- Merging
130−-------------------------------------------------------------------------------
131−
132−{-# INLINE mergeBy #-}
133−mergeBy :: Int -> Int -> IO ()
134−mergeBy count n =
135− S.drain $
136− S.mergeBy
137− compare
138− (sourceUnfoldrM count n)
139− (sourceUnfoldrM count (n + 1))
140−
141−{-# INLINE mergeByM #-}
142−mergeByM :: Int -> Int -> IO ()
143−mergeByM count n =
144− S.drain $
145− S.mergeByM
146− (\a b -> return $ compare a b)
147− (sourceUnfoldrM count n)
148− (sourceUnfoldrM count (n + 1))
149−
150−#ifdef INSPECTION
151−inspect $ hasNoTypeClasses 'mergeBy
152−inspect $ 'mergeBy `hasNoType` ''SPEC
153−inspect $ 'mergeBy `hasNoType` ''D.Step
154−
155−inspect $ hasNoTypeClasses 'mergeByM
156−inspect $ 'mergeByM `hasNoType` ''SPEC
157−inspect $ 'mergeByM `hasNoType` ''D.Step
158−#endif
159−
160o_1_space_joining :: Int -> [Benchmark]
128o_1_space_joining :: Int -> [Benchmark]
161o_1_space_joining value =
129o_1_space_joining value =
162 [ bgroup "joining"
130 [ bgroup "joining"
@@ -164,8 +132,6 @@ o_1_space_joining value =
164 , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
132 , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
165 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
133 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
166 , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
134 , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
167− , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
168− , benchIOSrc1 "mergeByM (2,x/2)" (mergeByM (value `div` 2))
169 ]
135 ]
170 ]
136 ]
171
137
@@ -263,30 +229,14 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
263
229
264-- concatPairWith
230-- concatPairWith
265
231
232+{-# INLINE concatPairWithSerial #-}
233+concatPairWithSerial :: Int -> Int -> Int -> IO ()
234+concatPairWithSerial = concatPairsWith Internal.serial
235+
266{-# INLINE concatPairWithAppend #-}
236{-# INLINE concatPairWithAppend #-}
267concatPairWithAppend :: Int -> Int -> Int -> IO ()
237concatPairWithAppend :: Int -> Int -> Int -> IO ()
268concatPairWithAppend = concatPairsWith Internal.append
238concatPairWithAppend = concatPairsWith Internal.append
269
239
270−{-# INLINE concatPairWithInterleave #-}
271−concatPairWithInterleave :: Int -> Int -> Int -> IO ()
272−concatPairWithInterleave = concatPairsWith Internal.interleave
273−
274−{-# INLINE concatPairWithInterleaveSuffix #-}
275−concatPairWithInterleaveSuffix :: Int -> Int -> Int -> IO ()
276−concatPairWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix
277−
278−{-# INLINE concatPairWithInterleaveInfix #-}
279−concatPairWithInterleaveInfix :: Int -> Int -> Int -> IO ()
280−concatPairWithInterleaveInfix = concatPairsWith Internal.interleaveInfix
281−
282−{-# INLINE concatPairWithInterleaveMin #-}
283−concatPairWithInterleaveMin :: Int -> Int -> Int -> IO ()
284−concatPairWithInterleaveMin = concatPairsWith Internal.interleaveMin
285−
286−{-# INLINE concatPairWithRoundrobin #-}
287−concatPairWithRoundrobin :: Int -> Int -> Int -> IO ()
288−concatPairWithRoundrobin = concatPairsWith Internal.roundrobin
289−
290-- unfoldMany
240-- unfoldMany
291
241
292-- unfoldMany replicate/unfoldrM
242-- unfoldMany replicate/unfoldrM
@@ -356,23 +306,18 @@ o_1_space_concat value = sqrtVal `seq`
356
306
357 -------------------concatPairsWith-----------------
307 -------------------concatPairsWith-----------------
358
308
359− , benchIOSrc1 "concatPairWithAppend"
309+ -- Use large number of streams to check scalability
360− (concatPairWithAppend 2 (value `div` 2))
310+ , benchIOSrc1 "concatPairWithSerial (n of 1)"
361− , benchIOSrc1 "concatPairWithInterleave"
311+ (concatPairWithSerial value 1)
362− (concatPairWithInterleave 2 (value `div` 2))
312+ , benchIOSrc1 "concatPairWithSerial (sqrtVal of sqrtVal)"
363−
313+ (concatPairWithSerial sqrtVal sqrtVal)
364− , benchIOSrc1 "concatPairWithInterleaveSuffix"
314+ , benchIOSrc1 "concatPairWithSerial (2 of n/2)"
365− (concatPairWithInterleaveSuffix 2 (value `div` 2))
315+ (concatPairWithSerial 2 (value `div` 2))
366−
316+
367− , benchIOSrc1 "concatPairWithInterleaveInfix"
317+ , benchIOSrc1 "concatPairWithAppend (n of 1)"
368− (concatPairWithInterleaveInfix 2 (value `div` 2))
318+ (concatPairWithAppend value 1)
369−
319+ , benchIOSrc1 "concatPairWithAppend (sqrtVal of sqrtVal)"
370− , benchIOSrc1 "concatPairWithInterleaveMin"
320+ (concatPairWithAppend sqrtVal sqrtVal)
371− (concatPairWithInterleaveMin 2 (value `div` 2))
372−
373− , benchIOSrc1 "concatPairWithRoundrobin"
374− (concatPairWithRoundrobin 2 (value `div` 2))
375−
376 ]
321 ]
377 ]
322 ]
378
323
benchmark/Streamly/Benchmark/Prelude/Serial/Transformation2.hs+1−8
@@ -20,7 +20,6 @@ import Control.Monad.IO.Class (MonadIO(..))
20import Data.Monoid (Sum(..))
20import Data.Monoid (Sum(..))
21import GHC.Generics (Generic)
21import GHC.Generics (Generic)
22
22
23−import qualified Data.List as List
24import qualified Streamly.Internal.Data.Fold as FL
23import qualified Streamly.Internal.Data.Fold as FL
25import qualified Streamly.Internal.Data.Stream.IsStream as Internal
24import qualified Streamly.Internal.Data.Stream.IsStream as Internal
26import qualified Streamly.Prelude as S
25import qualified Streamly.Prelude as S
@@ -175,19 +174,13 @@ reverse n = composeN n S.reverse
175reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
174reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
176reverse' n = composeN n Internal.reverse'
175reverse' n = composeN n Internal.reverse'
177
176
178−{-# INLINE sortBy #-}
179−sortBy :: MonadIO m => Int -> SerialT m Int -> m ()
180−sortBy n = composeN n (Internal.sortBy compare)
181−
182o_n_heap_buffering :: Int -> [Benchmark]
177o_n_heap_buffering :: Int -> [Benchmark]
183o_n_heap_buffering value =
178o_n_heap_buffering value =
184 [ bgroup "buffered"
179 [ bgroup "buffered"
185 [
180 [
186− -- Reversing/sorting a stream
181+ -- Reversing a stream
187 benchIOSink value "reverse" (reverse 1)
182 benchIOSink value "reverse" (reverse 1)
188 , benchIOSink value "reverse'" (reverse' 1)
183 , benchIOSink value "reverse'" (reverse' 1)
189− , benchIOSink value "sortBy" (sortBy 1)
190− , bench "sort Lists" $ nf (\x -> List.sort [1..x]) value
191
184
192 , benchIOSink value "mkAsync" (mkAsync fromSerial)
185 , benchIOSink value "mkAsync" (mkAsync fromSerial)
193 ]
186 ]
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+199−60
@@ -88,18 +88,54 @@ inspect $ 'roundRobin2 `hasNoType` ''SPEC
88inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
88inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
89#endif
89#endif
90
90
91−o_1_space_joining :: Int -> [Benchmark]
91+{-# INLINE sourceUnfoldrMUF #-}
92−o_1_space_joining value =
92+-- (count, value)
93− [ bgroup "joining"
93+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int
94− [ benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value)
94+sourceUnfoldrMUF count = UF.unfoldrM step
95− , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)
95+ where
96− , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)
96+ step (cnt, start) =
97− ]
97+ return $
98− ]
98+ if cnt > start + count
99+ then Nothing
100+ else Just (cnt, (cnt + 1, start))
101+
102+{-# INLINE unfoldManyInterleave #-}
103+unfoldManyInterleave :: Int -> Int -> Int -> IO ()
104+unfoldManyInterleave outer inner n =
105+ S.drain $ Internal.unfoldManyInterleave
106+ -- (UF.lmap return (UF.replicateM inner))
107+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
108+ (sourceUnfoldrM outer n)
99
109
100−-------------------------------------------------------------------------------
110+#ifdef INSPECTION
101−-- Concat
111+inspect $ hasNoTypeClasses 'unfoldManyInterleave
102−-------------------------------------------------------------------------------
112+-- inspect $ 'unfoldManyInterleave `hasNoType` ''SPEC
113+-- inspect $ 'unfoldManyInterleave `hasNoType`
114+-- ''D.ConcatUnfoldInterleaveState
115+#endif
116+
117+{-# INLINE unfoldManyRoundRobin #-}
118+unfoldManyRoundRobin :: Int -> Int -> Int -> IO ()
119+unfoldManyRoundRobin outer inner n =
120+ S.drain $ Internal.unfoldManyRoundRobin
121+ -- (UF.lmap return (UF.replicateM inner))
122+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
123+ (sourceUnfoldrM outer n)
124+
125+#ifdef INSPECTION
126+inspect $ hasNoTypeClasses 'unfoldManyRoundRobin
127+-- inspect $ 'unfoldManyRoundRobin `hasNoType` ''SPEC
128+-- inspect $ 'unfoldManyRoundRobin `hasNoType`
129+-- ''D.ConcatUnfoldInterleaveState
130+#endif
131+
132+{-# INLINE concatPairsWithWSerial #-}
133+concatPairsWithWSerial :: Int -> Int -> Int -> IO ()
134+concatPairsWithWSerial = concatPairsWith Internal.wSerial
135+
136+{-# INLINE concatPairsWithRoundrobin #-}
137+concatPairsWithRoundrobin :: Int -> Int -> Int -> IO ()
138+concatPairsWithRoundrobin = concatPairsWith Internal.roundrobin
103
139
104{-# INLINE concatMapWithWSerial #-}
140{-# INLINE concatMapWithWSerial #-}
105concatMapWithWSerial :: Int -> Int -> Int -> IO ()
141concatMapWithWSerial :: Int -> Int -> Int -> IO ()
@@ -110,86 +146,189 @@ inspect $ hasNoTypeClasses 'concatMapWithWSerial
110inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC
146inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC
111#endif
147#endif
112
148
149+o_1_space_joining :: Int -> [Benchmark]
150+o_1_space_joining value =
151+ [ bgroup "joining (2 of n/2)"
152+ [ benchIOSrc1 "wSerial" (wSerial2 value)
153+ , benchIOSrc1 "interleave" (interleave2 value)
154+ , benchIOSrc1 "roundRobin" (roundRobin2 value)
155+ , benchIOSrc1
156+ "concatMapWithWSerial"
157+ (concatMapWithWSerial 2 (value `div` 2))
158+ , benchIOSrc1
159+ "concatMapWithInterleave"
160+ (concatStreamsWith Internal.interleave 2 (value `div` 2))
161+ , benchIOSrc1
162+ "concatMapWithRoundrobin"
163+ (concatStreamsWith Internal.roundrobin 2 (value `div` 2))
164+ , benchIOSrc1
165+ "unfoldManyInterleave"
166+ (unfoldManyInterleave 2 (value `div` 2))
167+ , benchIOSrc1
168+ "concatPairsWithWSerial"
169+ (concatPairsWithWSerial 2 (value `div` 2))
170+ , benchIOSrc1
171+ "concatPairsWithRoundrobin"
172+ (concatPairsWithRoundrobin 2 (value `div` 2))
173+ ]
174+ ]
175+
176+-------------------------------------------------------------------------------
177+-- Concat
178+-------------------------------------------------------------------------------
179+
113o_1_space_concat :: Int -> [Benchmark]
180o_1_space_concat :: Int -> [Benchmark]
114o_1_space_concat value =
181o_1_space_concat value =
115− [ bgroup "concat"
182+ [ bgroup "concatMapWith"
116 [ benchIOSrc1
183 [ benchIOSrc1
117− "concatMapWithWSerial (2,x/2)"
184+ "concatMapWithWSerial (n of 1)"
118− (concatMapWithWSerial 2 (value `div` 2))
185+ (concatStreamsWith wSerial value 1)
186+ , benchIOSrc1
187+ "concatMapWithWSerial (sqrtVal of sqrtVal)"
188+ (concatStreamsWith wSerial sqrtVal sqrtVal)
189+ -- concatMapWith using StreamD versions of interleave operations are
190+ -- all quadratic, we just measure the sqrtVal benchmark for comparison.
191+ {-
119 , benchIOSrc1
192 , benchIOSrc1
120− "concatMapWithWSerial (x/2,2)"
193+ "concatMapWithInterleave (n of 1)"
121− (concatMapWithWSerial (value `div` 2) 2)
194+ (concatStreamsWith Internal.interleave value 1)
195+ -}
196+ , benchIOSrc1
197+ "concatMapWithInterleave (sqrtVal of sqrtVal)"
198+ (concatStreamsWith Internal.interleave sqrtVal sqrtVal)
199+ , benchIOSrc1
200+ "concatMapWithRoundrobin (sqrtVal of sqrtVal)"
201+ (concatStreamsWith Internal.roundrobin sqrtVal sqrtVal)
122 ]
202 ]
123 ]
203 ]
124
204
125−{-# INLINE unfoldManyInterleaveRepl4xN #-}
205+ where
126−unfoldManyInterleaveRepl4xN :: Int -> Int -> IO ()
127−unfoldManyInterleaveRepl4xN value n =
128− S.drain $ Internal.unfoldManyInterleave
129− (UF.lmap return (UF.replicateM 4))
130− (sourceUnfoldrM (value `div` 4) n)
131
206
132−#ifdef INSPECTION
207+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
133−inspect $ hasNoTypeClasses 'unfoldManyInterleaveRepl4xN
134−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType` ''SPEC
135−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType`
136−-- ''D.ConcatUnfoldInterleaveState
137−#endif
138
208
139−{-# INLINE unfoldManyRoundRobinRepl4xN #-}
209+{-# INLINE concatPairsWithInterleave #-}
140−unfoldManyRoundRobinRepl4xN :: Int -> Int -> IO ()
210+concatPairsWithInterleave :: Int -> Int -> Int -> IO ()
141−unfoldManyRoundRobinRepl4xN value n =
211+concatPairsWithInterleave = concatPairsWith Internal.interleave
142− S.drain $ Internal.unfoldManyRoundRobin
143− (UF.lmap return (UF.replicateM 4))
144− (sourceUnfoldrM (value `div` 4) n)
145
212
146−#ifdef INSPECTION
213+{-# INLINE concatPairsWithInterleaveSuffix #-}
147−inspect $ hasNoTypeClasses 'unfoldManyRoundRobinRepl4xN
214+concatPairsWithInterleaveSuffix :: Int -> Int -> Int -> IO ()
148−-- inspect $ 'unfoldManyRoundRobinRepl4xN `hasNoType` ''SPEC
215+concatPairsWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix
149−-- inspect $ 'unfoldManyRoundRobinRepl4xN `hasNoType`
216+
150−-- ''D.ConcatUnfoldInterleaveState
217+{-# INLINE concatPairsWithInterleaveInfix #-}
151−#endif
218+concatPairsWithInterleaveInfix :: Int -> Int -> Int -> IO ()
219+concatPairsWithInterleaveInfix = concatPairsWith Internal.interleaveInfix
220+
221+{-# INLINE concatPairsWithInterleaveMin #-}
222+concatPairsWithInterleaveMin :: Int -> Int -> Int -> IO ()
223+concatPairsWithInterleaveMin = concatPairsWith Internal.interleaveMin
152
224
153o_n_heap_concat :: Int -> [Benchmark]
225o_n_heap_concat :: Int -> [Benchmark]
154o_n_heap_concat value =
226o_n_heap_concat value =
155− [ bgroup "concat"
227+ [ bgroup "concatPairsWith"
156 [
228 [
157− -- interleave x/4 streams of 4 elements each. Needs to buffer
158− -- proportional to x/4. This is different from WSerial because
159− -- WSerial expands slowly because of binary interleave behavior and
160− -- this expands immediately because of Nary interleave behavior.
161 benchIOSrc1
229 benchIOSrc1
162− "unfoldManyInterleaveRepl (x/4,4)"
230+ "unfoldManyInterleave (n of 1)"
163− (unfoldManyInterleaveRepl4xN value)
231+ (unfoldManyInterleave value 1)
232+ , benchIOSrc1
233+ "unfoldManyInterleave (sqrtVal of sqrtVal)"
234+ (unfoldManyInterleave sqrtVal sqrtVal)
235+
236+ , benchIOSrc1
237+ "unfoldManyRoundRobin (n of 1)"
238+ (unfoldManyRoundRobin value 1)
239+ , benchIOSrc1
240+ "unfoldManyRoundRobin (sqrtVal of sqrtVal)"
241+ (unfoldManyRoundRobin sqrtVal sqrtVal)
242+
243+ , benchIOSrc1
244+ "concatPairsWithWSerial (n of 1)"
245+ (concatPairsWithWSerial value 1)
164 , benchIOSrc1
246 , benchIOSrc1
165− "unfoldManyRoundRobinRepl (x/4,4)"
247+ "concatPairsWithWSerial (sqrtVal of sqrtVal)"
166− (unfoldManyRoundRobinRepl4xN value)
248+ (concatPairsWithWSerial sqrtVal sqrtVal)
249+
250+ , benchIOSrc1
251+ "concatPairsWithInterleave (n of 1)"
252+ (concatPairsWithInterleave value 1)
253+ , benchIOSrc1
254+ "concatPairsWithInterleave (sqrtVal of sqrtVal)"
255+ (concatPairsWithInterleave sqrtVal sqrtVal)
256+
257+ , benchIOSrc1
258+ "concatPairsWithInterleaveSuffix (n of 1)"
259+ (concatPairsWithInterleaveSuffix value 1)
260+ , benchIOSrc1
261+ "concatPairsWithInterleaveSuffix (sqrtVal of sqrtVal)"
262+ (concatPairsWithInterleaveSuffix sqrtVal sqrtVal)
263+
264+ , benchIOSrc1
265+ "concatPairsWithInterleaveInfix (n of 1)"
266+ (concatPairsWithInterleaveInfix value 1)
267+ , benchIOSrc1
268+ "concatPairsWithInterleaveInfix (sqrtVal of sqrtVal)"
269+ (concatPairsWithInterleaveInfix sqrtVal sqrtVal)
270+
271+ , benchIOSrc1
272+ "concatPairsWithInterleaveMin (n of 1)"
273+ (concatPairsWithInterleaveMin value 1)
274+ , benchIOSrc1
275+ "concatPairsWithInterleaveMin (sqrtVal of sqrtVal)"
276+ (concatPairsWithInterleaveMin sqrtVal sqrtVal)
277+
278+ , benchIOSrc1
279+ "concatPairsWithRoundrobin (n of 1)"
280+ (concatPairsWithRoundrobin value 1)
281+ , benchIOSrc1
282+ "concatPairsWithRoundrobin (sqrtVal of sqrtVal)"
283+ (concatPairsWithRoundrobin sqrtVal sqrtVal)
167 ]
284 ]
168 ]
285 ]
169
286
287+ where
288+
289+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
290+
170-------------------------------------------------------------------------------
291-------------------------------------------------------------------------------
171-- Monad
292-- Monad
172-------------------------------------------------------------------------------
293-------------------------------------------------------------------------------
173
294
174o_1_space_outerProduct :: Int -> [Benchmark]
295o_1_space_outerProduct :: Int -> [Benchmark]
175o_1_space_outerProduct value =
296o_1_space_outerProduct value =
176− [ bgroup "monad-outer-product"
297+ [ bgroup "outer-product"
298+ [ benchIO
299+ "drain applicative (+) (sqrtVal of sqrtVal)"
177− [ benchIO "toNullAp" $ toNullAp value fromWSerial
300+ (toNullAp value fromWSerial)
301+ , benchIO
302+ "drain monad (+) (sqrtVal of sqrtVal)"
178− , benchIO "toNullM" $ toNullM value fromWSerial
303+ (toNullM value fromWSerial)
304+ , benchIO
305+ "drain monad (+) (cbrtVal of cbrtVal of cbrtVal)"
179− , benchIO "toNullM3" $ toNullM3 value fromWSerial
306+ (toNullM3 value fromWSerial)
307+ , benchIO
308+ "filterAllOut monad (+) (sqrtVal of sqrtVal)"
180− , benchIO "filterAllOutM" $ filterAllOutM value fromWSerial
309+ (filterAllOutM value fromWSerial)
310+ , benchIO
311+ "filterAllIn monad (+) (sqrtVal of sqrtVal)"
181− , benchIO "filterAllInM" $ filterAllInM value fromWSerial
312+ (filterAllInM value fromWSerial)
313+ , benchIO
314+ "filterSome monad (+) (sqrtVal of sqrtVal)"
182− , benchIO "filterSome" $ filterSome value fromWSerial
315+ (filterSome value fromWSerial)
316+ , benchIO
317+ "breakAfterSome monad (+) (sqrtVal of sqrtVal)"
183− , benchIO "breakAfterSome" $ breakAfterSome value fromWSerial
318+ (breakAfterSome value fromWSerial)
184 ]
319 ]
185 ]
320 ]
186
321
187o_n_space_outerProduct :: Int -> [Benchmark]
322o_n_space_outerProduct :: Int -> [Benchmark]
188o_n_space_outerProduct value =
323o_n_space_outerProduct value =
189 [ bgroup
324 [ bgroup
190− "monad-outer-product"
325+ "outer-product"
326+ [ benchIO
327+ "toList monad (+) (sqrtVal of sqrtVal)"
191− [ benchIO "toList" $ toListM value fromWSerial
328+ (toListM value fromWSerial)
329+ , benchIO
330+ "toListSome monad (+) (sqrtVal of sqrtVal)"
192− , benchIO "toListSome" $ toListSome value fromWSerial
331+ (toListSome value fromWSerial)
193 ]
332 ]
194 ]
333 ]
195
334
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+46−2
@@ -84,11 +84,28 @@ inspect $ 'zipWithM `hasNoType` ''SPEC
84inspect $ 'zipWithM `hasNoType` ''D.Step
84inspect $ 'zipWithM `hasNoType` ''D.Step
85#endif
85#endif
86
86
87+{-
88+{-# INLINE concatMapWithZip #-}
89+concatMapWithZip :: Int -> Int -> Int -> IO ()
90+concatMapWithZip = concatStreamsWith (S.zipWith (+))
91+-}
92+
93+{-# INLINE concatPairsWithZip #-}
94+concatPairsWithZip :: Int -> Int -> Int -> IO ()
95+concatPairsWithZip = concatPairsWith (S.zipWith (+))
96+
87o_1_space_joining :: Int -> [Benchmark]
97o_1_space_joining :: Int -> [Benchmark]
88o_1_space_joining value =
98o_1_space_joining value =
89 [ bgroup "joining"
99 [ bgroup "joining"
90− [ benchIOSrc1 "zip (2,x/2)" (zipWith (value `div` 2))
100+ [ benchIOSrc1 "zip (2 of n/2)" (zipWith (value `div` 2))
91− , benchIOSrc1 "zipM (2,x/2)" (zipWithM (value `div` 2))
101+ , benchIOSrc1 "zipM (2 of n/2)" (zipWithM (value `div` 2))
102+ {-
103+ -- Not correct because of nil stream at end issue.
104+ , benchIOSrc1 "concatMapWithZip (+) (2 of n/2)"
105+ (concatMapWithZip 2 (value `div` 2))
106+ -}
107+ , benchIOSrc1 "concatPairsWithZip (+) (2 of n/2)"
108+ (concatPairsWithZip 2 (value `div` 2))
92 ]
109 ]
93 ]
110 ]
94
111
@@ -103,11 +120,37 @@ o_1_space_mapping value =
103 ]
120 ]
104 ]
121 ]
105
122
123+-------------------------------------------------------------------------------
124+-- Concat
125+-------------------------------------------------------------------------------
126+
127+o_n_heap_concat :: Int -> [Benchmark]
128+o_n_heap_concat value =
129+ [ bgroup "concatPairsWith"
130+ [ {- -- This fails with stack overflow.
131+ benchIOSrc1 "concatMapWithZip (n of 1)"
132+ (concatMapWithZip value 1)
133+ -- Not correct because of nil stream at end issue.
134+ , benchIOSrc1 "concatMapWithZip (sqrtVal of sqrtVal)"
135+ (concatMapWithZip sqrtVal sqrtVal)
136+ -}
137+ benchIOSrc1 "concatPairsWithZip (n of 1)"
138+ (concatPairsWithZip value 1)
139+ , benchIOSrc1 "concatPairsWithZip (sqrtVal of sqrtVal)"
140+ (concatPairsWithZip sqrtVal sqrtVal)
141+ ]
142+ ]
143+
144+ where
145+
146+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
147+
106-------------------------------------------------------------------------------
148-------------------------------------------------------------------------------
107-- Monad outer product
149-- Monad outer product
108-------------------------------------------------------------------------------
150-------------------------------------------------------------------------------
109
151
110{-
152{-
153+-- Not correct because of nil stream at end issue.
111o_1_space_outerProduct :: Int -> [Benchmark]
154o_1_space_outerProduct :: Int -> [Benchmark]
112o_1_space_outerProduct value =
155o_1_space_outerProduct value =
113 [ bgroup "monad-outer-product"
156 [ bgroup "monad-outer-product"
@@ -133,6 +176,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
133 [ bgroup (o_1_space_prefix moduleName) $ concat
176 [ bgroup (o_1_space_prefix moduleName) $ concat
134 [ o_1_space_joining size
177 [ o_1_space_joining size
135 , o_1_space_mapping size
178 , o_1_space_mapping size
179+ , o_n_heap_concat size
136 -- XXX need to fix, timing in ns
180 -- XXX need to fix, timing in ns
137 -- , o_1_space_outerProduct size
181 -- , o_1_space_outerProduct size
138 ]
182 ]
benchmark/lib/Streamly/Benchmark/Prelude.hs+2−2
@@ -346,7 +346,7 @@ sourceConcatMapId value n =
346
346
347{-# INLINE concatStreamsWith #-}
347{-# INLINE concatStreamsWith #-}
348concatStreamsWith
348concatStreamsWith
349− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
349+ :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)
350 -> Int
350 -> Int
351 -> Int
351 -> Int
352 -> Int
352 -> Int
@@ -358,7 +358,7 @@ concatStreamsWith op outer inner n =
358
358
359{-# INLINE concatPairsWith #-}
359{-# INLINE concatPairsWith #-}
360concatPairsWith
360concatPairsWith
361− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
361+ :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)
362 -> Int
362 -> Int
363 -> Int
363 -> Int
364 -> Int
364 -> Int
benchmark/streamly-benchmarks.cabal+10
@@ -210,6 +210,16 @@ benchmark Prelude.WSerial
210 else
210 else
211 buildable: True
211 buildable: True
212
212
213+benchmark Prelude.Merge
214+ import: bench-options
215+ type: exitcode-stdio-1.0
216+ hs-source-dirs: Streamly/Benchmark/Prelude
217+ main-is: Merge.hs
218+ if impl(ghcjs)
219+ buildable: False
220+ else
221+ buildable: True
222+
213benchmark Prelude.ZipSerial
223benchmark Prelude.ZipSerial
214 import: bench-options
224 import: bench-options
215 type: exitcode-stdio-1.0
225 type: exitcode-stdio-1.0
hie.yaml+6
@@ -26,6 +26,8 @@ cradle:
26 component: "bench:Prelude.Ahead"
26 component: "bench:Prelude.Ahead"
27 - path: "./benchmark/Streamly/Benchmark/Prelude/Async.hs"
27 - path: "./benchmark/Streamly/Benchmark/Prelude/Async.hs"
28 component: "bench:Prelude.Async"
28 component: "bench:Prelude.Async"
29+ - path: "./benchmark/Streamly/Benchmark/Prelude/Merge.hs"
30+ component: "bench:Prelude.Merge"
29 - path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"
31 - path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"
30 component: "bench:Prelude.Parallel"
32 component: "bench:Prelude.Parallel"
31 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial.hs"
33 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial.hs"
@@ -44,6 +46,10 @@ cradle:
44 component: "bench:Prelude.Serial"
46 component: "bench:Prelude.Serial"
45 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Transformation3.hs"
47 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Transformation3.hs"
46 component: "bench:Prelude.Serial"
48 component: "bench:Prelude.Serial"
49+ - path: "./benchmark/Streamly/Benchmark/Prelude/WSerial.hs"
50+ component: "bench:Prelude.WSerial"
51+ - path: "./benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs"
52+ component: "bench:Prelude.ZipSerial"
47 - path: "./benchmark/Streamly/Benchmark/Unicode/Stream.hs"
53 - path: "./benchmark/Streamly/Benchmark/Unicode/Stream.hs"
48 component: "bench:Unicode.Stream"
54 component: "bench:Unicode.Stream"
49 - path: "./benchmark/lib/"
55 - path: "./benchmark/lib/"