benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs · streamly

git.iko.soy/streamly

on 4e604ef help sign in

streamly/benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs

453 lines 13 kB history raw

1-- |

2-- Module : Streamly.Benchmark.Data.Stream.StreamDK

4--

5-- License : BSD3

6-- Maintainer : streamly@composewell.com

8{-# LANGUAGE FlexibleContexts #-}

9{-# LANGUAGE ScopedTypeVariables #-}

11module Main (main) where

13-- import Control.Monad (when)

14-- import Data.Maybe (isJust)

15import Prelude hiding ()

16-- import qualified Prelude as P

17-- import qualified Data.List as List

19import qualified Streamly.Internal.Data.Stream.StreamDK as S

20-- import qualified Streamly.Internal.Data.Stream.Common as SP

21-- import qualified Streamly.Internal.Data.SVar as S

23import Streamly.Benchmark.Common

24import Gauge (bgroup, Benchmark, defaultMain)

26value :: Int

27value = 100000

28{-

29value2, value3, value16, maxValue :: Int

30value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop

31value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop

32value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop

33maxValue = value

34-}

36-------------------------------------------------------------------------------

37-- Benchmark ops

38-------------------------------------------------------------------------------

40-------------------------------------------------------------------------------

41-- Stream generation and elimination

42-------------------------------------------------------------------------------

44type Stream m a = S.Stream m a

46{-# INLINE sourceUnfoldr #-}

47sourceUnfoldr :: Monad m => Int -> Stream m Int

48sourceUnfoldr n = S.unfoldr step n

49 where

50 step cnt =

51 if cnt > n + value

52 then Nothing

53 else Just (cnt, cnt + 1)

55{-

56{-# INLINE sourceUnfoldrN #-}

57sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int

58sourceUnfoldrN m n = S.unfoldr step n

59 where

60 step cnt =

61 if cnt > n + m

62 then Nothing

63 else Just (cnt, cnt + 1)

64-}

66{-# INLINE sourceUnfoldrM #-}

67sourceUnfoldrM :: Monad m => Int -> Stream m Int

68sourceUnfoldrM n = S.unfoldrM step n

69 where

70 step cnt =

71 if cnt > n + value

72 then return Nothing

73 else return (Just (cnt, cnt + 1))

75{-

76{-# INLINE sourceUnfoldrMN #-}

77sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int

78sourceUnfoldrMN m n = S.unfoldrM step n

79 where

80 step cnt =

81 if cnt > n + m

82 then return Nothing

83 else return (Just (cnt, cnt + 1))

84-}

86{-

87{-# INLINE sourceFromEnum #-}

88sourceFromEnum :: Monad m => Int -> Stream m Int

89sourceFromEnum n = S.enumFromStepN n 1 value

90-}

92{-

93{-# INLINE sourceFromFoldable #-}

94sourceFromFoldable :: Int -> Stream m Int

95sourceFromFoldable n = S.fromFoldable [n..n+value]

96-}

98{-

99{-# INLINE sourceFromFoldableM #-}

100sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int

101sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])

102-}

103

104{-

105{-# INLINE sourceFoldMapWith #-}

106sourceFoldMapWith :: Int -> Stream m Int

107sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]

108

109{-# INLINE sourceFoldMapWithM #-}

110sourceFoldMapWithM :: Monad m => Int -> Stream m Int

111sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]

112-}

113

114-------------------------------------------------------------------------------

115-- Elimination

116-------------------------------------------------------------------------------

117

118{-# INLINE runStream #-}

119runStream :: Monad m => Stream m a -> m ()

120runStream = S.drain

121-- runStream = S.mapM_ (\_ -> return ())

122

123{-

124{-# INLINE mapM_ #-}

125mapM_ :: Monad m => Stream m a -> m ()

126mapM_ = S.mapM_ (\_ -> return ())

127-}

128

129{-# INLINE toNull #-}

130toNull :: Monad m => Stream m Int -> m ()

131toNull = runStream

132

133{-# INLINE uncons #-}

134uncons :: Monad m => Stream m Int -> m ()

135uncons s = do

136 r <- S.uncons s

137 case r of

138 Nothing -> return ()

139 Just (_, t) -> uncons t

140

141{-

142{-# INLINE init #-}

143init :: (Monad m, S.IsStream t) => t m a -> m ()

144init s = do

145 t <- S.init s

146 P.mapM_ S.drain t

147

148{-# INLINE tail #-}

149tail :: (Monad m, S.IsStream t) => t m a -> m ()

150tail s = S.tail s >>= P.mapM_ tail

151

152{-# INLINE nullTail #-}

153{-# INLINE headTail #-}

154{-# INLINE zip #-}

155nullTail, headTail, zip

156 :: Monad m

157 => Stream m Int -> m ()

158

159nullTail s = do

160 r <- S.null s

161 when (not r) $ S.tail s >>= P.mapM_ nullTail

162

163headTail s = do

164 h <- S.head s

165 when (isJust h) $ S.tail s >>= P.mapM_ headTail

166

167{-# INLINE toList #-}

168toList :: Monad m => Stream m Int -> m [Int]

169toList = S.toList

170

171{-# INLINE foldl #-}

172foldl :: Monad m => Stream m Int -> m Int

173foldl = S.foldl' (+) 0

174

175{-# INLINE last #-}

176last :: Monad m => Stream m Int -> m (Maybe Int)

177last = S.last

178-}

179

180-------------------------------------------------------------------------------

181-- Transformation

182-------------------------------------------------------------------------------

183

184{-

185{-# INLINE transform #-}

186transform :: Monad m => Stream m a -> m ()

187transform = runStream

188

189{-# INLINE composeN #-}

190composeN

191 :: Monad m

192 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()

193composeN n f =

194 case n of

195 1 -> transform . f

196 2 -> transform . f . f

197 3 -> transform . f . f . f

198 4 -> transform . f . f . f . f

199 _ -> undefined

200-}

201

202{-

203{-# INLINE scan #-}

204{-# INLINE map #-}

205{-# INLINE fmap #-}

206{-# INLINE filterEven #-}

207{-# INLINE filterAllOut #-}

208{-# INLINE filterAllIn #-}

209{-# INLINE takeOne #-}

210{-# INLINE takeAll #-}

211{-# INLINE takeWhileTrue #-}

212{-# INLINE dropOne #-}

213{-# INLINE dropAll #-}

214{-# INLINE dropWhileTrue #-}

215{-# INLINE dropWhileFalse #-}

216{-# INLINE foldlS #-}

217{-# INLINE concatMap #-}

218scan, map, fmap, filterEven, filterAllOut,

219 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,

220 dropWhileTrue, dropWhileFalse, foldlS, concatMap

221 :: Monad m

222 => Int -> Stream m Int -> m ()

223

224{-# INLINE mapM #-}

225{-# INLINE mapMSerial #-}

226{-# INLINE intersperse #-}

227mapM, mapMSerial, intersperse

228 :: S.MonadAsync m => Int -> Stream m Int -> m ()

229

230scan n = composeN n $ S.scanl' (+) 0

231map n = composeN n $ P.fmap (+1)

232fmap n = composeN n $ P.fmap (+1)

233mapM n = composeN n $ S.mapM return

234mapMSerial n = composeN n $ S.mapMSerial return

235filterEven n = composeN n $ S.filter even

236filterAllOut n = composeN n $ S.filter (> maxValue)

237filterAllIn n = composeN n $ S.filter (<= maxValue)

238takeOne n = composeN n $ S.take 1

239takeAll n = composeN n $ S.take maxValue

240takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)

241dropOne n = composeN n $ S.drop 1

242dropAll n = composeN n $ S.drop maxValue

243dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)

244dropWhileFalse n = composeN n $ S.dropWhile (<= 1)

245foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil

246-- We use a (sqrt n) element stream as source and then concat the same stream

247-- for each element to produce an n element stream.

248concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)

249intersperse n = composeN n $ S.intersperse maxValue

250

251-------------------------------------------------------------------------------

252-- Iteration

253-------------------------------------------------------------------------------

254

255iterStreamLen, maxIters :: Int

256iterStreamLen = 10

257maxIters = 10000

258

259{-# INLINE iterateSource #-}

260iterateSource

261 :: S.MonadAsync m

262 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int

263iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)

264 where

265 f (0 :: Int) m = g m

266 f x m = g (f (x P.- 1) m)

267

268{-# INLINE iterateMapM #-}

269{-# INLINE iterateScan #-}

270{-# INLINE iterateFilterEven #-}

271{-# INLINE iterateTakeAll #-}

272{-# INLINE iterateDropOne #-}

273{-# INLINE iterateDropWhileFalse #-}

274{-# INLINE iterateDropWhileTrue #-}

275iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,

276 iterateDropWhileFalse, iterateDropWhileTrue

277 :: S.MonadAsync m

278 => Int -> Stream m Int

279

280-- this is quadratic

281iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)

282iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))

283 (maxIters `div` 10)

284

285iterateMapM = iterateSource (S.mapM return) maxIters

286iterateFilterEven = iterateSource (S.filter even) maxIters

287iterateTakeAll = iterateSource (S.take maxValue) maxIters

288iterateDropOne = iterateSource (S.drop 1) maxIters

289iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters

290

291-------------------------------------------------------------------------------

292-- Zipping and concat

293-------------------------------------------------------------------------------

294

295zip src = transform $ S.zipWith (,) src src

296

297{-# INLINE concatMapRepl4xN #-}

298concatMapRepl4xN :: Monad m => Stream m Int -> m ()

299concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)

300

301-------------------------------------------------------------------------------

302-- Mixed Composition

303-------------------------------------------------------------------------------

304

305{-# INLINE scanMap #-}

306{-# INLINE dropMap #-}

307{-# INLINE dropScan #-}

308{-# INLINE takeDrop #-}

309{-# INLINE takeScan #-}

310{-# INLINE takeMap #-}

311{-# INLINE filterDrop #-}

312{-# INLINE filterTake #-}

313{-# INLINE filterScan #-}

314{-# INLINE filterMap #-}

315scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,

316 filterTake, filterScan, filterMap

317 :: Monad m => Int -> Stream m Int -> m ()

318

319scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0

320dropMap n = composeN n $ S.map (subtract 1) . S.drop 1

321dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1

322takeDrop n = composeN n $ S.drop 1 . S.take maxValue

323takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue

324takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue

325filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)

326filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)

327filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)

328filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)

329

330-------------------------------------------------------------------------------

331-- Nested Composition

332-------------------------------------------------------------------------------

333

334{-# INLINE toNullApNested #-}

335toNullApNested :: Monad m => Stream m Int -> m ()

336toNullApNested s = runStream $ do

337 (+) <$> s <*> s

338

339{-# INLINE toNullNested #-}

340toNullNested :: Monad m => Stream m Int -> m ()

341toNullNested s = runStream $ do

342 x <- s

343 y <- s

344 return $ x + y

345

346{-# INLINE toNullNested3 #-}

347toNullNested3 :: Monad m => Stream m Int -> m ()

348toNullNested3 s = runStream $ do

349 x <- s

350 y <- s

351 z <- s

352 return $ x + y + z

353

354{-# INLINE filterAllOutNested #-}

355filterAllOutNested

356 :: Monad m

357 => Stream m Int -> m ()

358filterAllOutNested str = runStream $ do

359 x <- str

360 y <- str

361 let s = x + y

362 if s < 0

363 then return s

364 else S.nil

365

366{-# INLINE filterAllInNested #-}

367filterAllInNested

368 :: Monad m

369 => Stream m Int -> m ()

370filterAllInNested str = runStream $ do

371 x <- str

372 y <- str

373 let s = x + y

374 if s > 0

375 then return s

376 else S.nil

377

378-------------------------------------------------------------------------------

379-- Nested Composition Pure lists

380-------------------------------------------------------------------------------

381

382{-# INLINE sourceUnfoldrList #-}

383sourceUnfoldrList :: Int -> Int -> [Int]

384sourceUnfoldrList maxval n = List.unfoldr step n

385 where

386 step cnt =

387 if cnt > n + maxval

388 then Nothing

389 else Just (cnt, cnt + 1)

390

391{-# INLINE toNullApNestedList #-}

392toNullApNestedList :: [Int] -> [Int]

393toNullApNestedList s = (+) <$> s <*> s

394

395{-# INLINE toNullNestedList #-}

396toNullNestedList :: [Int] -> [Int]

397toNullNestedList s = do

398 x <- s

399 y <- s

400 return $ x + y

401

402{-# INLINE toNullNestedList3 #-}

403toNullNestedList3 :: [Int] -> [Int]

404toNullNestedList3 s = do

405 x <- s

406 y <- s

407 z <- s

408 return $ x + y + z

409

410{-# INLINE filterAllOutNestedList #-}

411filterAllOutNestedList :: [Int] -> [Int]

412filterAllOutNestedList str = do

413 x <- str

414 y <- str

415 let s = x + y

416 if s < 0

417 then return s

418 else []

419

420{-# INLINE filterAllInNestedList #-}

421filterAllInNestedList :: [Int] -> [Int]

422filterAllInNestedList str = do

423 x <- str

424 y <- str

425 let s = x + y

426 if s > 0

427 then return s

428 else []

429-}

430

431-------------------------------------------------------------------------------

432-- Benchmarks

433-------------------------------------------------------------------------------

434

435moduleName :: String

436moduleName = "Data.Stream.StreamDK"

437

438o_1_space :: [Benchmark]

439o_1_space =

440 [ bgroup (o_1_space_prefix moduleName)

441 [ bgroup "generation"

442 [ benchFold "unfoldr" toNull sourceUnfoldr

443 , benchFold "unfoldrM" toNull sourceUnfoldrM

444 ]

445 , bgroup "elimination"

446 [ benchFold "toNull" toNull sourceUnfoldrM

447 , benchFold "uncons" uncons sourceUnfoldrM

448 ]

449 ]

450 ]

451

452main :: IO ()

453main = defaultMain $ concat [o_1_space]