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

git.iko.soy/streamly

on efecb26 help sign in

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

455 lines 13 kB history raw

1{-# OPTIONS_GHC -Wno-deprecations #-}

3-- |

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

6--

7-- License : BSD3

8-- Maintainer : streamly@composewell.com

10{-# LANGUAGE FlexibleContexts #-}

11{-# LANGUAGE ScopedTypeVariables #-}

13module Main (main) where

15-- import Control.Monad (when)

16-- import Data.Maybe (isJust)

17import Prelude hiding ()

18-- import qualified Prelude as P

19-- import qualified Data.List as List

21import qualified Streamly.Internal.Data.StreamK.Alt as S

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

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

25import Streamly.Benchmark.Common

26import Gauge (bgroup, Benchmark, defaultMain)

28value :: Int

29value = 100000

30{-

31value2, value3, value16, maxValue :: Int

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

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

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

35maxValue = value

36-}

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

39-- Benchmark ops

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

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

43-- Stream generation and elimination

44-------------------------------------------------------------------------------

46type Stream m a = S.Stream m a

48{-# INLINE sourceUnfoldr #-}

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

50sourceUnfoldr n = S.unfoldr step n

51 where

52 step cnt =

53 if cnt > n + value

54 then Nothing

55 else Just (cnt, cnt + 1)

57{-

58{-# INLINE sourceUnfoldrN #-}

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

60sourceUnfoldrN m n = S.unfoldr step n

61 where

62 step cnt =

63 if cnt > n + m

64 then Nothing

65 else Just (cnt, cnt + 1)

66-}

68{-# INLINE sourceUnfoldrM #-}

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

70sourceUnfoldrM n = S.unfoldrM step n

71 where

72 step cnt =

73 if cnt > n + value

74 then return Nothing

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

77{-

78{-# INLINE sourceUnfoldrMN #-}

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

80sourceUnfoldrMN m n = S.unfoldrM step n

81 where

82 step cnt =

83 if cnt > n + m

84 then return Nothing

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

86-}

88{-

89{-# INLINE sourceFromEnum #-}

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

91sourceFromEnum n = S.enumFromStepN n 1 value

92-}

94{-

95{-# INLINE sourceFromFoldable #-}

96sourceFromFoldable :: Int -> Stream m Int

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

98-}

100{-

101{-# INLINE sourceFromFoldableM #-}

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

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

104-}

105

106{-

107{-# INLINE sourceFoldMapWith #-}

108sourceFoldMapWith :: Int -> Stream m Int

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

110

111{-# INLINE sourceFoldMapWithM #-}

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

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

114-}

115

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

117-- Elimination

118-------------------------------------------------------------------------------

119

120{-# INLINE runStream #-}

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

122runStream = S.drain

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

124

125{-

126{-# INLINE mapM_ #-}

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

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

129-}

130

131{-# INLINE toNull #-}

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

133toNull = runStream

134

135{-# INLINE uncons #-}

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

137uncons s = do

138 r <- S.uncons s

139 case r of

140 Nothing -> return ()

141 Just (_, t) -> uncons t

142

143{-

144{-# INLINE init #-}

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

146init s = do

147 t <- S.init s

148 P.mapM_ S.drain t

149

150{-# INLINE tail #-}

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

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

153

154{-# INLINE nullTail #-}

155{-# INLINE headTail #-}

156{-# INLINE zip #-}

157nullTail, headTail, zip

158 :: Monad m

159 => Stream m Int -> m ()

160

161nullTail s = do

162 r <- S.null s

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

164

165headTail s = do

166 h <- S.head s

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

168

169{-# INLINE toList #-}

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

171toList = S.toList

172

173{-# INLINE foldl #-}

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

175foldl = S.foldl' (+) 0

176

177{-# INLINE last #-}

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

179last = S.last

180-}

181

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

183-- Transformation

184-------------------------------------------------------------------------------

185

186{-

187{-# INLINE transform #-}

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

189transform = runStream

190

191{-# INLINE composeN #-}

192composeN

193 :: Monad m

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

195composeN n f =

196 case n of

197 1 -> transform . f

198 2 -> transform . f . f

199 3 -> transform . f . f . f

200 4 -> transform . f . f . f . f

201 _ -> undefined

202-}

203

204{-

205{-# INLINE scan #-}

206{-# INLINE map #-}

207{-# INLINE fmap #-}

208{-# INLINE filterEven #-}

209{-# INLINE filterAllOut #-}

210{-# INLINE filterAllIn #-}

211{-# INLINE takeOne #-}

212{-# INLINE takeAll #-}

213{-# INLINE takeWhileTrue #-}

214{-# INLINE dropOne #-}

215{-# INLINE dropAll #-}

216{-# INLINE dropWhileTrue #-}

217{-# INLINE dropWhileFalse #-}

218{-# INLINE foldlS #-}

219{-# INLINE concatMap #-}

220scan, map, fmap, filterEven, filterAllOut,

221 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,

222 dropWhileTrue, dropWhileFalse, foldlS, concatMap

223 :: Monad m

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

225

226{-# INLINE mapM #-}

227{-# INLINE mapMSerial #-}

228{-# INLINE intersperse #-}

229mapM, mapMSerial, intersperse

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

231

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

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

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

235mapM n = composeN n $ S.mapM return

236mapMSerial n = composeN n $ S.mapMSerial return

237filterEven n = composeN n $ S.filter even

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

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

240takeOne n = composeN n $ S.take 1

241takeAll n = composeN n $ S.take maxValue

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

243dropOne n = composeN n $ S.drop 1

244dropAll n = composeN n $ S.drop maxValue

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

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

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

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

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

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

251intersperse n = composeN n $ S.intersperse maxValue

252

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

254-- Iteration

255-------------------------------------------------------------------------------

256

257iterStreamLen, maxIters :: Int

258iterStreamLen = 10

259maxIters = 10000

260

261{-# INLINE iterateSource #-}

262iterateSource

263 :: S.MonadAsync m

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

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

266 where

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

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

269

270{-# INLINE iterateMapM #-}

271{-# INLINE iterateScan #-}

272{-# INLINE iterateFilterEven #-}

273{-# INLINE iterateTakeAll #-}

274{-# INLINE iterateDropOne #-}

275{-# INLINE iterateDropWhileFalse #-}

276{-# INLINE iterateDropWhileTrue #-}

277iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,

278 iterateDropWhileFalse, iterateDropWhileTrue

279 :: S.MonadAsync m

280 => Int -> Stream m Int

281

282-- this is quadratic

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

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

285 (maxIters `div` 10)

286

287iterateMapM = iterateSource (S.mapM return) maxIters

288iterateFilterEven = iterateSource (S.filter even) maxIters

289iterateTakeAll = iterateSource (S.take maxValue) maxIters

290iterateDropOne = iterateSource (S.drop 1) maxIters

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

292

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

294-- Zipping and concat

295-------------------------------------------------------------------------------

296

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

298

299{-# INLINE concatMapRepl4xN #-}

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

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

302

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

304-- Mixed Composition

305-------------------------------------------------------------------------------

306

307{-# INLINE scanMap #-}

308{-# INLINE dropMap #-}

309{-# INLINE dropScan #-}

310{-# INLINE takeDrop #-}

311{-# INLINE takeScan #-}

312{-# INLINE takeMap #-}

313{-# INLINE filterDrop #-}

314{-# INLINE filterTake #-}

315{-# INLINE filterScan #-}

316{-# INLINE filterMap #-}

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

318 filterTake, filterScan, filterMap

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

320

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

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

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

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

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

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

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

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

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

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

331

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

333-- Nested Composition

334-------------------------------------------------------------------------------

335

336{-# INLINE toNullApNested #-}

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

338toNullApNested s = runStream $ do

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

340

341{-# INLINE toNullNested #-}

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

343toNullNested s = runStream $ do

344 x <- s

345 y <- s

346 return $ x + y

347

348{-# INLINE toNullNested3 #-}

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

350toNullNested3 s = runStream $ do

351 x <- s

352 y <- s

353 z <- s

354 return $ x + y + z

355

356{-# INLINE filterAllOutNested #-}

357filterAllOutNested

358 :: Monad m

359 => Stream m Int -> m ()

360filterAllOutNested str = runStream $ do

361 x <- str

362 y <- str

363 let s = x + y

364 if s < 0

365 then return s

366 else S.nil

367

368{-# INLINE filterAllInNested #-}

369filterAllInNested

370 :: Monad m

371 => Stream m Int -> m ()

372filterAllInNested str = runStream $ do

373 x <- str

374 y <- str

375 let s = x + y

376 if s > 0

377 then return s

378 else S.nil

379

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

381-- Nested Composition Pure lists

382-------------------------------------------------------------------------------

383

384{-# INLINE sourceUnfoldrList #-}

385sourceUnfoldrList :: Int -> Int -> [Int]

386sourceUnfoldrList maxval n = List.unfoldr step n

387 where

388 step cnt =

389 if cnt > n + maxval

390 then Nothing

391 else Just (cnt, cnt + 1)

392

393{-# INLINE toNullApNestedList #-}

394toNullApNestedList :: [Int] -> [Int]

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

396

397{-# INLINE toNullNestedList #-}

398toNullNestedList :: [Int] -> [Int]

399toNullNestedList s = do

400 x <- s

401 y <- s

402 return $ x + y

403

404{-# INLINE toNullNestedList3 #-}

405toNullNestedList3 :: [Int] -> [Int]

406toNullNestedList3 s = do

407 x <- s

408 y <- s

409 z <- s

410 return $ x + y + z

411

412{-# INLINE filterAllOutNestedList #-}

413filterAllOutNestedList :: [Int] -> [Int]

414filterAllOutNestedList str = do

415 x <- str

416 y <- str

417 let s = x + y

418 if s < 0

419 then return s

420 else []

421

422{-# INLINE filterAllInNestedList #-}

423filterAllInNestedList :: [Int] -> [Int]

424filterAllInNestedList str = do

425 x <- str

426 y <- str

427 let s = x + y

428 if s > 0

429 then return s

430 else []

431-}

432

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

434-- Benchmarks

435-------------------------------------------------------------------------------

436

437moduleName :: String

438moduleName = "Data.Stream.StreamDK"

439

440o_1_space :: [Benchmark]

441o_1_space =

442 [ bgroup (o_1_space_prefix moduleName)

443 [ bgroup "generation"

444 [ benchFold "unfoldr" toNull sourceUnfoldr

445 , benchFold "unfoldrM" toNull sourceUnfoldrM

446 ]

447 , bgroup "elimination"

448 [ benchFold "toNull" toNull sourceUnfoldrM

449 , benchFold "uncons" uncons sourceUnfoldrM

450 ]

451 ]

452 ]

453

454main :: IO ()

455main = defaultMain $ concat [o_1_space]