benchmark/LinearOps.hs · streamly

git.iko.soy/streamly

on bf4e5d8 help sign in

streamly/benchmark/LinearOps.hs

392 lines 12 kB history raw

1-- |

2-- Module : BenchmarkOps

4--

5-- License : MIT

6-- Maintainer : harendra.kumar@gmail.com

8{-# LANGUAGE CPP #-}

9{-# LANGUAGE FlexibleContexts #-}

10{-# LANGUAGE ScopedTypeVariables #-}

12module LinearOps where

14import Control.Monad (when)

15import Data.Maybe (fromJust)

16import Prelude

17 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),

18 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,

19 maxBound, div)

20import qualified Prelude as P

22import qualified Streamly as S

23import qualified Streamly.Prelude as S

25value, maxValue :: Int

26#ifdef LINEAR_ASYNC

27value = 10000

28#else

29value = 100000

30#endif

31maxValue = value + 1

33-------------------------------------------------------------------------------

34-- Benchmark ops

35-------------------------------------------------------------------------------

37-------------------------------------------------------------------------------

38-- Stream generation and elimination

39-------------------------------------------------------------------------------

41type Stream m a = S.SerialT m a

43{-# INLINE source #-}

44source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int

45source n = S.serially $ sourceUnfoldrM n

46-- source n = S.serially $ sourceFromList n

48{-# INLINE sourceFromList #-}

49sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int

50sourceFromList n = S.fromList [n..n+value]

52{-# INLINE sourceFromListM #-}

53sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int

54sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])

56{-# INLINE sourceFromFoldable #-}

57sourceFromFoldable :: S.IsStream t => Int -> t m Int

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

60{-# INLINE sourceFromFoldableM #-}

61sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

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

64{-# INLINE sourceFoldMapWith #-}

65sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))

66 => Int -> t m Int

67sourceFoldMapWith n = S.foldMapWith (S.<>) S.yield [n..n+value]

69{-# INLINE sourceFoldMapWithM #-}

70sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))

71 => Int -> t m Int

72sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]

74{-# INLINE sourceUnfoldr #-}

75sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int

76sourceUnfoldr n = S.unfoldr step n

77 where

78 step cnt =

79 if cnt > n + value

80 then Nothing

81 else Just (cnt, cnt + 1)

83{-# INLINE sourceUnfoldrM #-}

84sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

85sourceUnfoldrM n = S.unfoldrM step n

86 where

87 step cnt =

88 if cnt > n + value

89 then return Nothing

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

92{-# INLINE sourceUnfoldrMN #-}

93sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int

94sourceUnfoldrMN m n = S.unfoldrM step n

95 where

96 step cnt =

97 if cnt > n + m

98 then return Nothing

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

100

101{-# INLINE sourceUnfoldrMAction #-}

102sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> t m (m Int)

103sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n

104 where

105 step cnt =

106 if cnt > n + value

107 then return Nothing

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

109

110-------------------------------------------------------------------------------

111-- Elimination

112-------------------------------------------------------------------------------

113

114{-# INLINE runStream #-}

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

116runStream = S.runStream

117

118{-# INLINE toList #-}

119{-# INLINE foldr #-}

120{-# INLINE foldrM #-}

121toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]

122

123{-# INLINE last #-}

124{-# INLINE maximum #-}

125{-# INLINE minimum #-}

126{-# INLINE find #-}

127{-# INLINE findIndex #-}

128{-# INLINE elemIndex #-}

129{-# INLINE foldl1' #-}

130{-# INLINE foldr1 #-}

131last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1 :: Monad m => Stream m Int -> m (Maybe Int)

132

133{-# INLINE foldl' #-}

134{-# INLINE length #-}

135{-# INLINE sum #-}

136{-# INLINE product #-}

137foldl', length, sum, product :: Monad m => Stream m Int -> m Int

138

139{-# INLINE all #-}

140{-# INLINE any #-}

141{-# INLINE and #-}

142{-# INLINE or #-}

143{-# INLINE elem #-}

144{-# INLINE notElem #-}

145elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool

146

147{-# INLINE toNull #-}

148toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()

149toNull t = runStream . t

150

151{-# INLINE uncons #-}

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

153uncons s = do

154 r <- S.uncons s

155 case r of

156 Nothing -> return ()

157 Just (_, t) -> uncons t

158

159{-# INLINE init #-}

160init :: Monad m => Stream m a -> m ()

161init s = S.init s >>= Prelude.mapM_ S.runStream

162

163{-# INLINE tail #-}

164tail :: Monad m => Stream m a -> m ()

165tail s = S.tail s >>= Prelude.mapM_ tail

166

167{-# INLINE nullHeadTail #-}

168nullHeadTail :: Monad m => Stream m Int -> m ()

169nullHeadTail s = do

170 r <- S.null s

171 when (not r) $ do

172 _ <- S.head s

173 S.tail s >>= Prelude.mapM_ nullHeadTail

174

175{-# INLINE mapM_ #-}

176mapM_ :: Monad m => Stream m Int -> m ()

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

178

179toList = S.toList

180foldr = S.foldr (:) []

181foldr1 = S.foldr1 (+)

182foldrM = S.foldrM (\a xs -> return (a : xs)) []

183foldl' = S.foldl' (+) 0

184foldl1' = S.foldl1' (+)

185last = S.last

186elem = S.elem maxValue

187notElem = S.notElem maxValue

188length = S.length

189all = S.all (<= maxValue)

190any = S.any (> maxValue)

191and = S.and . S.map (<= maxValue)

192or = S.or . S.map (> maxValue)

193find = S.find (== maxValue)

194findIndex = S.findIndex (== maxValue)

195elemIndex = S.elemIndex maxValue

196maximum = S.maximum

197minimum = S.minimum

198sum = S.sum

199product = S.product

200

201-------------------------------------------------------------------------------

202-- Transformation

203-------------------------------------------------------------------------------

204

205{-# INLINE transform #-}

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

207transform = runStream

208

209{-# INLINE composeN #-}

210composeN

211 :: Monad m

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

213composeN n f =

214 case n of

215 1 -> transform . f

216 2 -> transform . f . f

217 3 -> transform . f . f . f

218 4 -> transform . f . f . f . f

219 _ -> undefined

220

221-- polymorphic stream version of composeN

222{-# INLINE composeN' #-}

223composeN'

224 :: (S.IsStream t, Monad m)

225 => Int -> (t m Int -> Stream m Int) -> t m Int -> m ()

226composeN' n f =

227 case n of

228 1 -> transform . f

229 2 -> transform . f . S.adapt . f

230 3 -> transform . f . S.adapt . f . S.adapt . f

231 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f

232 _ -> undefined

233

234{-# INLINE scan #-}

235{-# INLINE map #-}

236{-# INLINE fmap #-}

237{-# INLINE mapMaybe #-}

238{-# INLINE filterEven #-}

239{-# INLINE filterAllOut #-}

240{-# INLINE filterAllIn #-}

241{-# INLINE takeOne #-}

242{-# INLINE takeAll #-}

243{-# INLINE takeWhileTrue #-}

244{-# INLINE takeWhileMTrue #-}

245{-# INLINE dropOne #-}

246{-# INLINE dropAll #-}

247{-# INLINE dropWhileTrue #-}

248{-# INLINE dropWhileMTrue #-}

249{-# INLINE dropWhileFalse #-}

250{-# INLINE findIndices #-}

251{-# INLINE elemIndices #-}

252scan, map, fmap, mapMaybe, filterEven, filterAllOut,

253 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

254 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

255 findIndices, elemIndices

256 :: Monad m

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

258

259{-# INLINE mapMaybeM #-}

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

261

262{-# INLINE mapM #-}

263mapM :: (S.IsStream t, S.MonadAsync m)

264 => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()

265

266{-# INLINE sequence #-}

267sequence :: (S.IsStream t, S.MonadAsync m)

268 => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()

269

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

271fmap n = composeN n $ Prelude.fmap (+1)

272map n = composeN n $ S.map (+1)

273mapM t n = composeN' n $ t . S.mapM return

274mapMaybe n = composeN n $ S.mapMaybe

275 (\x -> if Prelude.odd x then Nothing else Just x)

276mapMaybeM n = composeN n $ S.mapMaybeM

277 (\x -> if Prelude.odd x then return Nothing else return $ Just x)

278sequence t = transform . t . S.sequence

279filterEven n = composeN n $ S.filter even

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

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

282takeOne n = composeN n $ S.take 1

283takeAll n = composeN n $ S.take maxValue

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

285takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))

286dropOne n = composeN n $ S.drop 1

287dropAll n = composeN n $ S.drop maxValue

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

289dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))

290dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)

291findIndices n = composeN n $ S.findIndices (== maxValue)

292elemIndices n = composeN n $ S.elemIndices maxValue

293

294-------------------------------------------------------------------------------

295-- Iteration

296-------------------------------------------------------------------------------

297

298iterStreamLen, maxIters :: Int

299iterStreamLen = 10

300maxIters = 10000

301

302{-# INLINE iterateSource #-}

303iterateSource

304 :: S.MonadAsync m

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

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

307 where

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

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

310

311{-# INLINE iterateMapM #-}

312{-# INLINE iterateScan #-}

313{-# INLINE iterateFilterEven #-}

314{-# INLINE iterateTakeAll #-}

315{-# INLINE iterateDropOne #-}

316{-# INLINE iterateDropWhileFalse #-}

317{-# INLINE iterateDropWhileTrue #-}

318iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,

319 iterateDropWhileFalse, iterateDropWhileTrue

320 :: S.MonadAsync m

321 => Int -> Stream m Int

322

323-- this is quadratic

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

325

326iterateMapM = iterateSource (S.mapM return) maxIters

327iterateFilterEven = iterateSource (S.filter even) maxIters

328iterateTakeAll = iterateSource (S.take maxValue) maxIters

329iterateDropOne = iterateSource (S.drop 1) maxIters

330iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters

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

332

333-------------------------------------------------------------------------------

334-- Zipping and concat

335-------------------------------------------------------------------------------

336

337{-# INLINE zip #-}

338{-# INLINE zipM #-}

339{-# INLINE concat #-}

340zip, zipM, concat :: Monad m => Stream m Int -> m ()

341

342zip src = do

343 r <- S.tail src

344 let src1 = fromJust r

345 transform (S.zipWith (,) src src1)

346zipM src = do

347 r <- S.tail src

348 let src1 = fromJust r

349 transform (S.zipWithM (curry return) src src1)

350

351{-# INLINE zipAsync #-}

352{-# INLINE zipAsyncM #-}

353zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()

354

355zipAsync src = do

356 r <- S.tail src

357 let src1 = fromJust r

358 transform (S.zipAsyncWith (,) src src1)

359zipAsyncM src = do

360 r <- S.tail src

361 let src1 = fromJust r

362 transform (S.zipAsyncWithM (curry return) src src1)

363concat _n = return ()

364

365-------------------------------------------------------------------------------

366-- Mixed Composition

367-------------------------------------------------------------------------------

368

369{-# INLINE scanMap #-}

370{-# INLINE dropMap #-}

371{-# INLINE dropScan #-}

372{-# INLINE takeDrop #-}

373{-# INLINE takeScan #-}

374{-# INLINE takeMap #-}

375{-# INLINE filterDrop #-}

376{-# INLINE filterTake #-}

377{-# INLINE filterScan #-}

378{-# INLINE filterMap #-}

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

380 filterTake, filterScan, filterMap

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

382

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

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

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

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

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

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

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

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

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

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