benchmark/LinearOps.hs · streamly

git.iko.soy/streamly

on 5bb0a49 help sign in

streamly/benchmark/LinearOps.hs

530 lines 17 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.Functor.Identity (Identity, runIdentity)

16import Data.Maybe (fromJust)

17import Prelude

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

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

20 maxBound, div, IO, compare)

21import qualified Prelude as P

22import qualified Data.Foldable as F

23import qualified GHC.Exts as GHC

25import qualified Streamly as S

26import qualified Streamly.Prelude as S

28value, maxValue :: Int

29#ifdef LINEAR_ASYNC

30value = 10000

31#else

32value = 100000

33#endif

34maxValue = value + 1

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

37-- Benchmark ops

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

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

41-- Stream generation and elimination

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

44type Stream m a = S.SerialT m a

46{-# INLINE source #-}

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

48source n = S.serially $ sourceUnfoldrM n

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

51{-# INLINE sourceFromList #-}

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

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

55{-# INLINE sourceFromListM #-}

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

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

59{-# INLINE sourceFromFoldable #-}

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

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

63{-# INLINE sourceFromFoldableM #-}

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

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

67{-# INLINE sourceFoldMapWith #-}

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

69 => Int -> t m Int

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

72{-# INLINE sourceFoldMapWithM #-}

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

74 => Int -> t m Int

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

77{-# INLINE sourceUnfoldr #-}

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

79sourceUnfoldr n = S.unfoldr step n

80 where

81 step cnt =

82 if cnt > n + value

83 then Nothing

84 else Just (cnt, cnt + 1)

86{-# INLINE sourceUnfoldrM #-}

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

88sourceUnfoldrM n = S.unfoldrM step n

89 where

90 step cnt =

91 if cnt > n + value

92 then return Nothing

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

95{-# INLINE sourceUnfoldrMN #-}

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

97sourceUnfoldrMN m n = S.unfoldrM step n

98 where

99 step cnt =

100 if cnt > n + m

101 then return Nothing

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

103

104{-# INLINE sourceUnfoldrMAction #-}

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

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

107 where

108 step cnt =

109 if cnt > n + value

110 then return Nothing

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

112

113-------------------------------------------------------------------------------

114-- Pure stream generation

115-------------------------------------------------------------------------------

116

117{-# INLINE sourceIsList #-}

118sourceIsList :: Int -> S.SerialT Identity Int

119sourceIsList n = GHC.fromList [n..n+value]

120

121{-# INLINE sourceIsString #-}

122sourceIsString :: Int -> S.SerialT Identity P.Char

123sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')

124

125-------------------------------------------------------------------------------

126-- Elimination

127-------------------------------------------------------------------------------

128

129{-# INLINE runStream #-}

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

131runStream = S.runStream

132

133{-# INLINE toList #-}

134{-# INLINE foldr #-}

135{-# INLINE foldrM #-}

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

137

138{-# INLINE last #-}

139{-# INLINE maximum #-}

140{-# INLINE minimum #-}

141{-# INLINE find #-}

142{-# INLINE findIndex #-}

143{-# INLINE elemIndex #-}

144{-# INLINE foldl1' #-}

145{-# INLINE foldr1 #-}

146last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1

147 :: Monad m => Stream m Int -> m (Maybe Int)

148

149{-# INLINE minimumBy #-}

150{-# INLINE maximumBy #-}

151minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)

152

153{-# INLINE foldl' #-}

154{-# INLINE length #-}

155{-# INLINE sum #-}

156{-# INLINE product #-}

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

158

159{-# INLINE all #-}

160{-# INLINE any #-}

161{-# INLINE and #-}

162{-# INLINE or #-}

163{-# INLINE elem #-}

164{-# INLINE notElem #-}

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

166

167{-# INLINE toNull #-}

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

169toNull t = runStream . t

170

171{-# INLINE uncons #-}

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

173uncons s = do

174 r <- S.uncons s

175 case r of

176 Nothing -> return ()

177 Just (_, t) -> uncons t

178

179{-# INLINE init #-}

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

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

182

183{-# INLINE tail #-}

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

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

186

187{-# INLINE nullHeadTail #-}

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

189nullHeadTail s = do

190 r <- S.null s

191 when (not r) $ do

192 _ <- S.head s

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

194

195{-# INLINE mapM_ #-}

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

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

198

199toList = S.toList

200foldr = S.foldr (:) []

201foldr1 = S.foldr1 (+)

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

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

204foldl1' = S.foldl1' (+)

205last = S.last

206elem = S.elem maxValue

207notElem = S.notElem maxValue

208length = S.length

209all = S.all (<= maxValue)

210any = S.any (> maxValue)

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

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

213find = S.find (== maxValue)

214findIndex = S.findIndex (== maxValue)

215elemIndex = S.elemIndex maxValue

216maximum = S.maximum

217minimum = S.minimum

218sum = S.sum

219product = S.product

220minimumBy = S.minimumBy compare

221maximumBy = S.maximumBy compare

222

223-------------------------------------------------------------------------------

224-- Transformation

225-------------------------------------------------------------------------------

226

227{-# INLINE transform #-}

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

229transform = runStream

230

231{-# INLINE composeN #-}

232composeN

233 :: Monad m

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

235composeN n f =

236 case n of

237 1 -> transform . f

238 2 -> transform . f . f

239 3 -> transform . f . f . f

240 4 -> transform . f . f . f . f

241 _ -> undefined

242

243-- polymorphic stream version of composeN

244{-# INLINE composeN' #-}

245composeN'

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

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

248composeN' n f =

249 case n of

250 1 -> transform . f

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

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

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

254 _ -> undefined

255

256{-# INLINE scan #-}

257{-# INLINE scanl1 #-}

258{-# INLINE map #-}

259{-# INLINE fmap #-}

260{-# INLINE mapMaybe #-}

261{-# INLINE filterEven #-}

262{-# INLINE filterAllOut #-}

263{-# INLINE filterAllIn #-}

264{-# INLINE takeOne #-}

265{-# INLINE takeAll #-}

266{-# INLINE takeWhileTrue #-}

267{-# INLINE takeWhileMTrue #-}

268{-# INLINE dropOne #-}

269{-# INLINE dropAll #-}

270{-# INLINE dropWhileTrue #-}

271{-# INLINE dropWhileMTrue #-}

272{-# INLINE dropWhileFalse #-}

273{-# INLINE findIndices #-}

274{-# INLINE elemIndices #-}

275{-# INLINE insertLarge #-}

276{-# INLINE insertSmall #-}

277{-# INLINE deleteLarge #-}

278{-# INLINE deleteSmall #-}

279scan, scanl1, map, fmap, mapMaybe, filterEven, filterAllOut,

280 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

281 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

282 findIndices, elemIndices, insertLarge, insertSmall, deleteLarge,

283 deleteSmall

284 :: Monad m

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

286

287{-# INLINE mapMaybeM #-}

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

289

290{-# INLINE mapM #-}

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

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

293

294{-# INLINE sequence #-}

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

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

297

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

299scanl1 n = composeN n $ S.scanl1' (+)

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

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

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

303mapMaybe n = composeN n $ S.mapMaybe

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

305mapMaybeM n = composeN n $ S.mapMaybeM

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

307sequence t = transform . t . S.sequence

308filterEven n = composeN n $ S.filter even

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

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

311takeOne n = composeN n $ S.take 1

312takeAll n = composeN n $ S.take maxValue

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

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

315dropOne n = composeN n $ S.drop 1

316dropAll n = composeN n $ S.drop maxValue

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

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

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

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

321elemIndices n = composeN n $ S.elemIndices maxValue

322insertLarge n = composeN n $ S.insertBy compare maxValue

323insertSmall n = composeN n $ S.insertBy compare 0

324deleteSmall n = composeN n $ S.deleteBy (==) 0

325deleteLarge n = composeN n $ S.deleteBy (>=) maxValue

326

327

328-------------------------------------------------------------------------------

329-- Iteration

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

331

332iterStreamLen, maxIters :: Int

333iterStreamLen = 10

334maxIters = 10000

335

336{-# INLINE iterateSource #-}

337iterateSource

338 :: S.MonadAsync m

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

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

341 where

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

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

344

345{-# INLINE iterateMapM #-}

346{-# INLINE iterateScan #-}

347{-# INLINE iterateScanl1 #-}

348{-# INLINE iterateFilterEven #-}

349{-# INLINE iterateTakeAll #-}

350{-# INLINE iterateDropOne #-}

351{-# INLINE iterateDropWhileFalse #-}

352{-# INLINE iterateDropWhileTrue #-}

353iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

354 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

355 :: S.MonadAsync m

356 => Int -> Stream m Int

357

358-- this is quadratic

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

360-- so is this

361iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)

362

363iterateMapM = iterateSource (S.mapM return) maxIters

364iterateFilterEven = iterateSource (S.filter even) maxIters

365iterateTakeAll = iterateSource (S.take maxValue) maxIters

366iterateDropOne = iterateSource (S.drop 1) maxIters

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

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

369

370-------------------------------------------------------------------------------

371-- Zipping and concat

372-------------------------------------------------------------------------------

373

374{-# INLINE zip #-}

375{-# INLINE zipM #-}

376{-# INLINE merge #-}

377{-# INLINE concat #-}

378{-# INLINE isPrefixOf #-}

379{-# INLINE isPrefixAll #-}

380{-# INLINE isSubsequenceOf #-}

381{-# INLINE evenSubsequence #-}

382{-# INLINE stripPrefix #-}

383zip, zipM, concat, merge, isPrefixOf, isPrefixAll, isSubsequenceOf,

384 evenSubsequence, stripPrefix

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

386

387zip src = do

388 r <- S.tail src

389 let src1 = fromJust r

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

391zipM src = do

392 r <- S.tail src

393 let src1 = fromJust r

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

395

396merge src = do

397 r <- S.tail src

398 let src1 = fromJust r

399 transform (S.mergeBy P.compare src src1)

400

401isPrefixOf src = do

402 let src1 = S.take 10 src

403 _ <- S.isPrefixOf src1 src

404 return ()

405

406isPrefixAll src = do

407 _ <- S.isPrefixOf src src

408 return ()

409

410isSubsequenceOf src = do

411 let src1 = S.take 10 src

412 _ <- S.isSubsequenceOf src1 src

413 return ()

414

415evenSubsequence src = do

416 let src1 = S.filter even src

417 _ <- S.isSubsequenceOf src1 src

418 return ()

419

420stripPrefix src = do

421 let src1 = S.take 10 src

422 _ <- S.stripPrefix src1 src

423 return ()

424

425{-# INLINE zipAsync #-}

426{-# INLINE zipAsyncM #-}

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

428

429zipAsync src = do

430 r <- S.tail src

431 let src1 = fromJust r

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

433zipAsyncM src = do

434 r <- S.tail src

435 let src1 = fromJust r

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

437

438concat _n = return ()

439

440{-# INLINE eqBy #-}

441eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool

442eqBy src = S.eqBy (==) src src

443

444{-# INLINE cmpBy #-}

445cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering

446cmpBy src = S.cmpBy P.compare src src

447

448-------------------------------------------------------------------------------

449-- Mixed Composition

450-------------------------------------------------------------------------------

451

452{-# INLINE scanMap #-}

453{-# INLINE dropMap #-}

454{-# INLINE dropScan #-}

455{-# INLINE takeDrop #-}

456{-# INLINE takeScan #-}

457{-# INLINE takeMap #-}

458{-# INLINE filterDrop #-}

459{-# INLINE filterTake #-}

460{-# INLINE filterScan #-}

461{-# INLINE filterScanl1 #-}

462{-# INLINE filterMap #-}

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

464 filterTake, filterScan, filterScanl1, filterMap

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

466

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

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

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

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

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

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

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

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

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

476filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)

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

478

479-------------------------------------------------------------------------------

480-- Pure stream operations

481-------------------------------------------------------------------------------

482

483{-# INLINE eqInstance #-}

484eqInstance :: Stream Identity Int -> Bool

485eqInstance src = src == src

486

487{-# INLINE eqInstanceNotEq #-}

488eqInstanceNotEq :: Stream Identity Int -> Bool

489eqInstanceNotEq src = src P./= src

490

491{-# INLINE ordInstance #-}

492ordInstance :: Stream Identity Int -> Bool

493ordInstance src = src P.< src

494

495{-# INLINE ordInstanceMin #-}

496ordInstanceMin :: Stream Identity Int -> Stream Identity Int

497ordInstanceMin src = P.min src src

498

499{-# INLINE showInstance #-}

500showInstance :: Stream Identity Int -> P.String

501showInstance src = P.showsPrec 0 src ""

502

503{-# INLINE showInstanceList #-}

504showInstanceList :: Stream Identity Int -> P.String

505showInstanceList src = P.showsPrec 0 (GHC.toList src P.++ [2..value]) ""

506

507{-# INLINE readInstance #-}

508readInstance :: Stream Identity Int -> Stream Identity Int

509readInstance src =

510 let r = P.readsPrec 0 ("fromList [1"

511 P.++ P.concat (P.replicate value ",1") P.++ "]")

512 in case r of

513 [(x,"")] -> src S.<> x

514 _ -> P.error "readInstance: no parse"

515

516{-# INLINE pureFoldl' #-}

517pureFoldl' :: Stream Identity Int -> Int

518pureFoldl' = runIdentity . S.foldl' (+) 0

519

520{-# INLINE foldableFoldl' #-}

521foldableFoldl' :: Stream Identity Int -> Int

522foldableFoldl' = F.foldl' (+) 0

523

524{-# INLINE foldableSum #-}

525foldableSum :: Stream Identity Int -> Int

526foldableSum = P.sum

527

528{-# INLINE traversableMapM #-}

529traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)

530traversableMapM = P.mapM return