68317a4 · streamly · git.iko.soy

git.iko.soy/streamly

Fix/enhance benchmarks for concatPairsWith

* Add a benchmark for mergeByMFused * Move interleaving benchmarks to WSerial module * Rename some wserial benchmarks * Add a Merge module for mergeBy/sorting benchmarks

commit68317a4a413c8abf8ab4c6aecc37e411af40d328 authorHarendra Kumar <harendra@composewell.com> dateSat 25 Sep 2021, 11:16 (5 years ago) parent42b4ff2

10 files changed+560−144

compare with master

unifiedsplit

.hlint.ignore+1−1 benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+9 benchmark/Streamly/Benchmark/Prelude/Merge.hs+270 benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs+16−71 benchmark/Streamly/Benchmark/Prelude/Serial/Transformation2.hs+1−8 benchmark/Streamly/Benchmark/Prelude/WSerial.hs+199−60 benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+46−2 benchmark/lib/Streamly/Benchmark/Prelude.hs+2−2 benchmark/streamly-benchmarks.cabal+10 hie.yaml+6

.hlint.ignore+1−1

@@ -42,6 +42,7 @@ benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs

4242benchmark/Streamly/Benchmark/Data/Unfold.hs

4343benchmark/Streamly/Benchmark/FileSystem/Handle.hs

4444benchmark/Streamly/Benchmark/Prelude/Async.hs

45+benchmark/Streamly/Benchmark/Prelude/Merge.hs

4546benchmark/Streamly/Benchmark/Prelude/Parallel.hs

4647benchmark/Streamly/Benchmark/Prelude/Rate.hs

4748benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs

@@ -50,4 +51,3 @@ benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs

5051benchmark/Streamly/Benchmark/Prelude/Serial/Transformation1.hs

5152benchmark/Streamly/Benchmark/Prelude/WAsync.hs

5253benchmark/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 =

384384zipWith :: Monad m => Stream m Int -> m ()

385385zipWith src = drain $ S.zipWith (,) src src

386386

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+

387395-------------------------------------------------------------------------------

388396-- Mixed Composition

389397-------------------------------------------------------------------------------

@@ -700,6 +708,7 @@ o_1_space_concat streamLen =

700708 (concatMapBySerial streamLen2 streamLen2)

701709 , benchIOSrc1 "concatMapBy serial (1 of n)"

702710 (concatMapBySerial 1 streamLen)

711+ , benchFold "sortBy" sortBy (unfoldrM streamLen)

703712 ]

704713 where

705714 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

4+--

5+-- License : BSD3

6+-- Maintainer : streamly@composewell.com

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

125125inspect $ 'append2 `hasNoType` ''D.AppendState

126126#endif

127127

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−

160128o_1_space_joining :: Int -> [Benchmark]

161129o_1_space_joining value =

162130 [ bgroup "joining"

@@ -164,8 +132,6 @@ o_1_space_joining value =

164132 , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))

165133 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))

166134 , 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))

169135 ]

170136 ]

171137

@@ -263,30 +229,14 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC

263229

264230-- concatPairWith

265231

232+{-# INLINE concatPairWithSerial #-}

233+concatPairWithSerial :: Int -> Int -> Int -> IO ()

234+concatPairWithSerial = concatPairsWith Internal.serial

235+

266236{-# INLINE concatPairWithAppend #-}

267237concatPairWithAppend :: Int -> Int -> Int -> IO ()

268238concatPairWithAppend = concatPairsWith Internal.append

269239

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−

290240-- unfoldMany

291241

292242-- unfoldMany replicate/unfoldrM

@@ -356,23 +306,18 @@ o_1_space_concat value = sqrtVal `seq`

356306

357307 -------------------concatPairsWith-----------------

358308

359− , benchIOSrc1 "concatPairWithAppend"

360− (concatPairWithAppend 2 (value `div` 2))

361− , benchIOSrc1 "concatPairWithInterleave"

362− (concatPairWithInterleave 2 (value `div` 2))

363−

364− , benchIOSrc1 "concatPairWithInterleaveSuffix"

365− (concatPairWithInterleaveSuffix 2 (value `div` 2))

366−

367− , benchIOSrc1 "concatPairWithInterleaveInfix"

368− (concatPairWithInterleaveInfix 2 (value `div` 2))

369−

370− , benchIOSrc1 "concatPairWithInterleaveMin"

371− (concatPairWithInterleaveMin 2 (value `div` 2))

372−

373− , benchIOSrc1 "concatPairWithRoundrobin"

374− (concatPairWithRoundrobin 2 (value `div` 2))

375−

309+ -- Use large number of streams to check scalability

310+ , benchIOSrc1 "concatPairWithSerial (n of 1)"

311+ (concatPairWithSerial value 1)

312+ , benchIOSrc1 "concatPairWithSerial (sqrtVal of sqrtVal)"

313+ (concatPairWithSerial sqrtVal sqrtVal)

314+ , benchIOSrc1 "concatPairWithSerial (2 of n/2)"

315+ (concatPairWithSerial 2 (value `div` 2))

316+

317+ , benchIOSrc1 "concatPairWithAppend (n of 1)"

318+ (concatPairWithAppend value 1)

319+ , benchIOSrc1 "concatPairWithAppend (sqrtVal of sqrtVal)"

320+ (concatPairWithAppend sqrtVal sqrtVal)

376321 ]

377322 ]

378323

benchmark/Streamly/Benchmark/Prelude/Serial/Transformation2.hs+1−8

@@ -20,7 +20,6 @@ import Control.Monad.IO.Class (MonadIO(..))

2020import Data.Monoid (Sum(..))

2121import GHC.Generics (Generic)

2222

23−import qualified Data.List as List

2423import qualified Streamly.Internal.Data.Fold as FL

2524import qualified Streamly.Internal.Data.Stream.IsStream as Internal

2625import qualified Streamly.Prelude as S

@@ -175,19 +174,13 @@ reverse n = composeN n S.reverse

175174reverse' :: MonadIO m => Int -> SerialT m Int -> m ()

176175reverse' n = composeN n Internal.reverse'

177176

178−{-# INLINE sortBy #-}

179−sortBy :: MonadIO m => Int -> SerialT m Int -> m ()

180−sortBy n = composeN n (Internal.sortBy compare)

181−

182177o_n_heap_buffering :: Int -> [Benchmark]

183178o_n_heap_buffering value =

184179 [ bgroup "buffered"

185180 [

186− -- Reversing/sorting a stream

181+ -- Reversing a stream

187182 benchIOSink value "reverse" (reverse 1)

188183 , benchIOSink value "reverse'" (reverse' 1)

189− , benchIOSink value "sortBy" (sortBy 1)

190− , bench "sort Lists" $ nf (\x -> List.sort [1..x]) value

191184

192185 , benchIOSink value "mkAsync" (mkAsync fromSerial)

193186 ]

benchmark/Streamly/Benchmark/Prelude/WSerial.hs+199−60

@@ -88,18 +88,54 @@ inspect $ 'roundRobin2 `hasNoType` ''SPEC

8888inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState

8989#endif

9090

91−o_1_space_joining :: Int -> [Benchmark]

92−o_1_space_joining value =

93− [ bgroup "joining"

94− [ benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value)

95− , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)

96− , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)

97− ]

98− ]

91+{-# INLINE sourceUnfoldrMUF #-}

92+-- (count, value)

93+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int

94+sourceUnfoldrMUF count = UF.unfoldrM step

95+ where

96+ step (cnt, start) =

97+ return $

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)

99109

100−-------------------------------------------------------------------------------

101−-- Concat

102−-------------------------------------------------------------------------------

110+#ifdef INSPECTION

111+inspect $ hasNoTypeClasses 'unfoldManyInterleave

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

103139

104140{-# INLINE concatMapWithWSerial #-}

105141concatMapWithWSerial :: Int -> Int -> Int -> IO ()

@@ -110,86 +146,189 @@ inspect $ hasNoTypeClasses 'concatMapWithWSerial

110146inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC

111147#endif

112148

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+

113180o_1_space_concat :: Int -> [Benchmark]

114181o_1_space_concat value =

115− [ bgroup "concat"

182+ [ bgroup "concatMapWith"

116183 [ benchIOSrc1

117− "concatMapWithWSerial (2,x/2)"

118− (concatMapWithWSerial 2 (value `div` 2))

184+ "concatMapWithWSerial (n of 1)"

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+ {-

119192 , benchIOSrc1

120− "concatMapWithWSerial (x/2,2)"

121− (concatMapWithWSerial (value `div` 2) 2)

193+ "concatMapWithInterleave (n of 1)"

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)

122202 ]

123203 ]

124204

125−{-# INLINE unfoldManyInterleaveRepl4xN #-}

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)

205+ where

131206

132−#ifdef INSPECTION

133−inspect $ hasNoTypeClasses 'unfoldManyInterleaveRepl4xN

134−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType` ''SPEC

135−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType`

136−-- ''D.ConcatUnfoldInterleaveState

137−#endif

207+ sqrtVal = round $ sqrt (fromIntegral value :: Double)

138208

139−{-# INLINE unfoldManyRoundRobinRepl4xN #-}

140−unfoldManyRoundRobinRepl4xN :: Int -> Int -> IO ()

141−unfoldManyRoundRobinRepl4xN value n =

142− S.drain $ Internal.unfoldManyRoundRobin

143− (UF.lmap return (UF.replicateM 4))

144− (sourceUnfoldrM (value `div` 4) n)

209+{-# INLINE concatPairsWithInterleave #-}

210+concatPairsWithInterleave :: Int -> Int -> Int -> IO ()

211+concatPairsWithInterleave = concatPairsWith Internal.interleave

145212

146−#ifdef INSPECTION

147−inspect $ hasNoTypeClasses 'unfoldManyRoundRobinRepl4xN

148−-- inspect $ 'unfoldManyRoundRobinRepl4xN `hasNoType` ''SPEC

149−-- inspect $ 'unfoldManyRoundRobinRepl4xN `hasNoType`

150−-- ''D.ConcatUnfoldInterleaveState

151−#endif

213+{-# INLINE concatPairsWithInterleaveSuffix #-}

214+concatPairsWithInterleaveSuffix :: Int -> Int -> Int -> IO ()

215+concatPairsWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix

216+

217+{-# INLINE concatPairsWithInterleaveInfix #-}

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

152224

153225o_n_heap_concat :: Int -> [Benchmark]

154226o_n_heap_concat value =

155− [ bgroup "concat"

227+ [ bgroup "concatPairsWith"

156228 [

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.

161229 benchIOSrc1

162− "unfoldManyInterleaveRepl (x/4,4)"

163− (unfoldManyInterleaveRepl4xN value)

230+ "unfoldManyInterleave (n of 1)"

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)

164246 , benchIOSrc1

165− "unfoldManyRoundRobinRepl (x/4,4)"

166− (unfoldManyRoundRobinRepl4xN value)

247+ "concatPairsWithWSerial (sqrtVal of sqrtVal)"

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)

167284 ]

168285 ]

169286

287+ where

288+

289+ sqrtVal = round $ sqrt (fromIntegral value :: Double)

290+

170291-------------------------------------------------------------------------------

171292-- Monad

172293-------------------------------------------------------------------------------

173294

174295o_1_space_outerProduct :: Int -> [Benchmark]

175296o_1_space_outerProduct value =

176− [ bgroup "monad-outer-product"

177− [ benchIO "toNullAp" $ toNullAp value fromWSerial

178− , benchIO "toNullM" $ toNullM value fromWSerial

179− , benchIO "toNullM3" $ toNullM3 value fromWSerial

180− , benchIO "filterAllOutM" $ filterAllOutM value fromWSerial

181− , benchIO "filterAllInM" $ filterAllInM value fromWSerial

182− , benchIO "filterSome" $ filterSome value fromWSerial

183− , benchIO "breakAfterSome" $ breakAfterSome value fromWSerial

297+ [ bgroup "outer-product"

298+ [ benchIO

299+ "drain applicative (+) (sqrtVal of sqrtVal)"

300+ (toNullAp value fromWSerial)

301+ , benchIO

302+ "drain monad (+) (sqrtVal of sqrtVal)"

303+ (toNullM value fromWSerial)

304+ , benchIO

305+ "drain monad (+) (cbrtVal of cbrtVal of cbrtVal)"

306+ (toNullM3 value fromWSerial)

307+ , benchIO

308+ "filterAllOut monad (+) (sqrtVal of sqrtVal)"

309+ (filterAllOutM value fromWSerial)

310+ , benchIO

311+ "filterAllIn monad (+) (sqrtVal of sqrtVal)"

312+ (filterAllInM value fromWSerial)

313+ , benchIO

314+ "filterSome monad (+) (sqrtVal of sqrtVal)"

315+ (filterSome value fromWSerial)

316+ , benchIO

317+ "breakAfterSome monad (+) (sqrtVal of sqrtVal)"

318+ (breakAfterSome value fromWSerial)

184319 ]

185320 ]

186321

187322o_n_space_outerProduct :: Int -> [Benchmark]

188323o_n_space_outerProduct value =

189324 [ bgroup

190− "monad-outer-product"

191− [ benchIO "toList" $ toListM value fromWSerial

192− , benchIO "toListSome" $ toListSome value fromWSerial

325+ "outer-product"

326+ [ benchIO

327+ "toList monad (+) (sqrtVal of sqrtVal)"

328+ (toListM value fromWSerial)

329+ , benchIO

330+ "toListSome monad (+) (sqrtVal of sqrtVal)"

331+ (toListSome value fromWSerial)

193332 ]

194333 ]

195334

benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+46−2

@@ -84,11 +84,28 @@ inspect $ 'zipWithM `hasNoType` ''SPEC

8484inspect $ 'zipWithM `hasNoType` ''D.Step

8585#endif

8686

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+

8797o_1_space_joining :: Int -> [Benchmark]

8898o_1_space_joining value =

8999 [ bgroup "joining"

90− [ benchIOSrc1 "zip (2,x/2)" (zipWith (value `div` 2))

91− , benchIOSrc1 "zipM (2,x/2)" (zipWithM (value `div` 2))

100+ [ benchIOSrc1 "zip (2 of n/2)" (zipWith (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))

92109 ]

93110 ]

94111

@@ -103,11 +120,37 @@ o_1_space_mapping value =

103120 ]

104121 ]

105122

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+

106148-------------------------------------------------------------------------------

107149-- Monad outer product

108150-------------------------------------------------------------------------------

109151

110152{-

153+-- Not correct because of nil stream at end issue.

111154o_1_space_outerProduct :: Int -> [Benchmark]

112155o_1_space_outerProduct value =

113156 [ bgroup "monad-outer-product"

@@ -133,6 +176,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks

133176 [ bgroup (o_1_space_prefix moduleName) $ concat

134177 [ o_1_space_joining size

135178 , o_1_space_mapping size

179+ , o_n_heap_concat size

136180 -- XXX need to fix, timing in ns

137181 -- , o_1_space_outerProduct size

138182 ]

benchmark/lib/Streamly/Benchmark/Prelude.hs+2−2

@@ -346,7 +346,7 @@ sourceConcatMapId value n =

346346

347347{-# INLINE concatStreamsWith #-}

348348concatStreamsWith

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)

350350 -> Int

351351 -> Int

352352 -> Int

@@ -358,7 +358,7 @@ concatStreamsWith op outer inner n =

358358

359359{-# INLINE concatPairsWith #-}

360360concatPairsWith

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)

362362 -> Int

363363 -> Int

364364 -> Int

benchmark/streamly-benchmarks.cabal+10

@@ -210,6 +210,16 @@ benchmark Prelude.WSerial

210210 else

211211 buildable: True

212212

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+

213223benchmark Prelude.ZipSerial

214224 import: bench-options

215225 type: exitcode-stdio-1.0

hie.yaml+6

@@ -26,6 +26,8 @@ cradle:

2626 component: "bench:Prelude.Ahead"

2727 - path: "./benchmark/Streamly/Benchmark/Prelude/Async.hs"

2828 component: "bench:Prelude.Async"

29+ - path: "./benchmark/Streamly/Benchmark/Prelude/Merge.hs"

30+ component: "bench:Prelude.Merge"

2931 - path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"

3032 component: "bench:Prelude.Parallel"

3133 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial.hs"

@@ -44,6 +46,10 @@ cradle:

4446 component: "bench:Prelude.Serial"

4547 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Transformation3.hs"

4648 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"

4753 - path: "./benchmark/Streamly/Benchmark/Unicode/Stream.hs"

4854 component: "bench:Unicode.Stream"

4955 - path: "./benchmark/lib/"