benchmark/LinearOps.hs · streamly

git.iko.soy/streamly

on 57fad21 help sign in

streamly/benchmark/LinearOps.hs

545 lines 18 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 #-}

11{-# LANGUAGE DeriveAnyClass #-}

12{-# LANGUAGE DeriveGeneric #-}

14module LinearOps where

16import Control.Monad (when)

17import Data.Functor.Identity (Identity, runIdentity)

18import Data.Maybe (fromJust)

19import Prelude

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

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

22 maxBound, div, IO, compare, Double, fromIntegral, Integer)

23import qualified Prelude as P

24import qualified Data.Foldable as F

25import qualified GHC.Exts as GHC

26import Control.DeepSeq (NFData)

27import GHC.Generics (Generic)

29import qualified Streamly as S

30import qualified Streamly.Prelude as S

32value, maxValue :: Int

33#ifdef LINEAR_ASYNC

34value = 10000

35#else

36value = 100000

37#endif

38maxValue = value + 1

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

41-- Benchmark ops

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

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

45-- Stream generation and elimination

46-------------------------------------------------------------------------------

48type Stream m a = S.SerialT m a

50{-# INLINE source #-}

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

52source n = S.serially $ sourceUnfoldrM n

54{-# INLINE sourceIntFromTo #-}

55sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> t m Int

56sourceIntFromTo n = S.intFromTo n (n + value)

58{-# INLINE sourceIntFromThenTo #-}

59sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Int

60sourceIntFromThenTo n = S.intFromThenTo n (n + 1) (n + value)

62{-# INLINE sourceFracFromTo #-}

63sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> t m Double

64sourceFracFromTo n = S.fracFromTo (fromIntegral n) (fromIntegral (n + value))

66{-# INLINE sourceFracFromThenTo #-}

67sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Double

68sourceFracFromThenTo n = S.fracFromThenTo (fromIntegral n)

69 (fromIntegral n + 1.0001) (fromIntegral (n + value))

71{-# INLINE sourceIntegerFromStep #-}

72sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> t m Integer

73sourceIntegerFromStep n = S.take value $ S.intFromStep (fromIntegral n) 1

75{-# INLINE sourceFromList #-}

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

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

79{-# INLINE sourceFromListM #-}

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

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

83{-# INLINE sourceFromFoldable #-}

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

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

87{-# INLINE sourceFromFoldableM #-}

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

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

91{-# INLINE sourceFoldMapWith #-}

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

93 => Int -> t m Int

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

96{-# INLINE sourceFoldMapWithM #-}

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

98 => Int -> t m Int

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

100

101{-# INLINE sourceUnfoldr #-}

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

103sourceUnfoldr n = S.unfoldr step n

104 where

105 step cnt =

106 if cnt > n + value

107 then Nothing

108 else Just (cnt, cnt + 1)

109

110{-# INLINE sourceUnfoldrM #-}

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

112sourceUnfoldrM n = S.unfoldrM step n

113 where

114 step cnt =

115 if cnt > n + value

116 then return Nothing

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

118

119{-# INLINE sourceUnfoldrMN #-}

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

121sourceUnfoldrMN m n = S.unfoldrM step n

122 where

123 step cnt =

124 if cnt > n + m

125 then return Nothing

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

127

128{-# INLINE sourceUnfoldrMAction #-}

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

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

131 where

132 step cnt =

133 if cnt > n + value

134 then return Nothing

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

136

137-------------------------------------------------------------------------------

138-- Pure stream generation

139-------------------------------------------------------------------------------

140

141{-# INLINE sourceIsList #-}

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

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

144

145{-# INLINE sourceIsString #-}

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

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

148

149-------------------------------------------------------------------------------

150-- Elimination

151-------------------------------------------------------------------------------

152

153{-# INLINE runStream #-}

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

155runStream = S.runStream

156

157{-# INLINE toList #-}

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

159

160{-# INLINE last #-}

161{-# INLINE maximum #-}

162{-# INLINE minimum #-}

163{-# INLINE find #-}

164{-# INLINE findIndex #-}

165{-# INLINE elemIndex #-}

166{-# INLINE foldl1' #-}

167{-# INLINE foldr1 #-}

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

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

170

171{-# INLINE minimumBy #-}

172{-# INLINE maximumBy #-}

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

174

175{-# INLINE foldl' #-}

176{-# INLINE length #-}

177{-# INLINE sum #-}

178{-# INLINE product #-}

179foldl', foldr, foldrM, length, sum, product :: Monad m => Stream m Int -> m Int

180

181{-# INLINE all #-}

182{-# INLINE any #-}

183{-# INLINE and #-}

184{-# INLINE or #-}

185{-# INLINE elem #-}

186{-# INLINE notElem #-}

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

188

189{-# INLINE toNull #-}

190toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()

191toNull t = runStream . t

192

193{-# INLINE uncons #-}

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

195uncons s = do

196 r <- S.uncons s

197 case r of

198 Nothing -> return ()

199 Just (_, t) -> uncons t

200

201{-# INLINE init #-}

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

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

204

205{-# INLINE tail #-}

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

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

208

209{-# INLINE nullHeadTail #-}

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

211nullHeadTail s = do

212 r <- S.null s

213 when (not r) $ do

214 _ <- S.head s

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

216

217{-# INLINE mapM_ #-}

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

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

220

221toList = S.toList

222foldr = S.foldr (+) 0

223foldr1 = S.foldr1 (+)

224foldrM = S.foldrM (\a xs -> return $ a + xs) 0

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

226foldl1' = S.foldl1' (+)

227last = S.last

228elem = S.elem maxValue

229notElem = S.notElem maxValue

230length = S.length

231all = S.all (<= maxValue)

232any = S.any (> maxValue)

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

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

235find = S.find (== maxValue)

236findIndex = S.findIndex (== maxValue)

237elemIndex = S.elemIndex maxValue

238maximum = S.maximum

239minimum = S.minimum

240sum = S.sum

241product = S.product

242minimumBy = S.minimumBy compare

243maximumBy = S.maximumBy compare

244

245-------------------------------------------------------------------------------

246-- Transformation

247-------------------------------------------------------------------------------

248

249{-# INLINE transform #-}

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

251transform = runStream

252

253{-# INLINE composeN #-}

254composeN

255 :: Monad m

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

257composeN n f =

258 case n of

259 1 -> transform . f

260 2 -> transform . f . f

261 3 -> transform . f . f . f

262 4 -> transform . f . f . f . f

263 _ -> undefined

264

265-- polymorphic stream version of composeN

266{-# INLINE composeN' #-}

267composeN'

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

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

270composeN' n f =

271 case n of

272 1 -> transform . f

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

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

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

276 _ -> undefined

277

278{-# INLINE scan #-}

279{-# INLINE scanl1' #-}

280{-# INLINE map #-}

281{-# INLINE fmap #-}

282{-# INLINE mapMaybe #-}

283{-# INLINE filterEven #-}

284{-# INLINE filterAllOut #-}

285{-# INLINE filterAllIn #-}

286{-# INLINE takeOne #-}

287{-# INLINE takeAll #-}

288{-# INLINE takeWhileTrue #-}

289{-# INLINE takeWhileMTrue #-}

290{-# INLINE dropOne #-}

291{-# INLINE dropAll #-}

292{-# INLINE dropWhileTrue #-}

293{-# INLINE dropWhileMTrue #-}

294{-# INLINE dropWhileFalse #-}

295{-# INLINE findIndices #-}

296{-# INLINE elemIndices #-}

297{-# INLINE insertBy #-}

298{-# INLINE deleteBy #-}

299scan, scanl1', map, fmap, mapMaybe, filterEven, filterAllOut,

300 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

301 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

302 findIndices, elemIndices, insertBy, deleteBy

303 :: Monad m

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

305

306{-# INLINE mapMaybeM #-}

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

308

309{-# INLINE mapM #-}

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

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

312

313{-# INLINE sequence #-}

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

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

316

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

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

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

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

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

322mapMaybe n = composeN n $ S.mapMaybe

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

324mapMaybeM n = composeN n $ S.mapMaybeM

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

326sequence t = transform . t . S.sequence

327filterEven n = composeN n $ S.filter even

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

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

330takeOne n = composeN n $ S.take 1

331takeAll n = composeN n $ S.take maxValue

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

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

334dropOne n = composeN n $ S.drop 1

335dropAll n = composeN n $ S.drop maxValue

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

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

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

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

340elemIndices n = composeN n $ S.elemIndices maxValue

341insertBy n = composeN n $ S.insertBy compare maxValue

342deleteBy n = composeN n $ S.deleteBy (>=) maxValue

343

344-------------------------------------------------------------------------------

345-- Iteration

346-------------------------------------------------------------------------------

347

348iterStreamLen, maxIters :: Int

349iterStreamLen = 10

350maxIters = 10000

351

352{-# INLINE iterateSource #-}

353iterateSource

354 :: S.MonadAsync m

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

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

357 where

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

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

360

361{-# INLINE iterateMapM #-}

362{-# INLINE iterateScan #-}

363{-# INLINE iterateScanl1 #-}

364{-# INLINE iterateFilterEven #-}

365{-# INLINE iterateTakeAll #-}

366{-# INLINE iterateDropOne #-}

367{-# INLINE iterateDropWhileFalse #-}

368{-# INLINE iterateDropWhileTrue #-}

369iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

370 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

371 :: S.MonadAsync m

372 => Int -> Stream m Int

373

374-- this is quadratic

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

376-- so is this

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

378

379iterateMapM = iterateSource (S.mapM return) maxIters

380iterateFilterEven = iterateSource (S.filter even) maxIters

381iterateTakeAll = iterateSource (S.take maxValue) maxIters

382iterateDropOne = iterateSource (S.drop 1) maxIters

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

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

385

386-------------------------------------------------------------------------------

387-- Zipping and concat

388-------------------------------------------------------------------------------

389

390{-# INLINE zip #-}

391{-# INLINE zipM #-}

392{-# INLINE mergeBy #-}

393zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()

394

395zip src = do

396 r <- S.tail src

397 let src1 = fromJust r

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

399zipM src = do

400 r <- S.tail src

401 let src1 = fromJust r

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

403

404mergeBy src = do

405 r <- S.tail src

406 let src1 = fromJust r

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

408

409{-# INLINE isPrefixOf #-}

410{-# INLINE isSubsequenceOf #-}

411isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool

412

413isPrefixOf src = S.isPrefixOf src src

414isSubsequenceOf src = S.isSubsequenceOf src src

415

416{-# INLINE stripPrefix #-}

417stripPrefix :: Monad m => Stream m Int -> m ()

418stripPrefix src = do

419 _ <- S.stripPrefix src src

420 return ()

421

422{-# INLINE zipAsync #-}

423{-# INLINE zipAsyncM #-}

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

425

426zipAsync src = do

427 r <- S.tail src

428 let src1 = fromJust r

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

430zipAsyncM src = do

431 r <- S.tail src

432 let src1 = fromJust r

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

434

435{-# INLINE eqBy #-}

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

437eqBy src = S.eqBy (==) src src

438

439{-# INLINE cmpBy #-}

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

441cmpBy src = S.cmpBy P.compare src src

442

443concatStreamLen, maxNested :: Int

444concatStreamLen = 1

445maxNested = 100000

446

447{-# INLINE concatMap #-}

448concatMap :: S.MonadAsync m => Int -> Stream m Int

449concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)

450 (sourceUnfoldrMN concatStreamLen n)

451

452-------------------------------------------------------------------------------

453-- Mixed Composition

454-------------------------------------------------------------------------------

455

456{-# INLINE scanMap #-}

457{-# INLINE dropMap #-}

458{-# INLINE dropScan #-}

459{-# INLINE takeDrop #-}

460{-# INLINE takeScan #-}

461{-# INLINE takeMap #-}

462{-# INLINE filterDrop #-}

463{-# INLINE filterTake #-}

464{-# INLINE filterScan #-}

465{-# INLINE filterScanl1 #-}

466{-# INLINE filterMap #-}

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

468 filterTake, filterScan, filterScanl1, filterMap

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

470

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

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

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

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

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

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

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

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

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

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

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

482

483data Pair a b = Pair !a !b deriving (Generic, NFData)

484

485{-# INLINE sumProductFold #-}

486sumProductFold :: Monad m => Stream m Int -> m (Int, Int)

487sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)

488

489{-# INLINE sumProductScan #-}

490sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)

491sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)

492 . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)

493

494-------------------------------------------------------------------------------

495-- Pure stream operations

496-------------------------------------------------------------------------------

497

498{-# INLINE eqInstance #-}

499eqInstance :: Stream Identity Int -> Bool

500eqInstance src = src == src

501

502{-# INLINE eqInstanceNotEq #-}

503eqInstanceNotEq :: Stream Identity Int -> Bool

504eqInstanceNotEq src = src P./= src

505

506{-# INLINE ordInstance #-}

507ordInstance :: Stream Identity Int -> Bool

508ordInstance src = src P.< src

509

510{-# INLINE ordInstanceMin #-}

511ordInstanceMin :: Stream Identity Int -> Stream Identity Int

512ordInstanceMin src = P.min src src

513

514{-# INLINE showInstance #-}

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

516showInstance src = P.show src

517

518{-# INLINE showInstanceList #-}

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

520showInstanceList src = P.show (GHC.toList src P.++ [2..value])

521

522{-# INLINE readInstance #-}

523readInstance :: Stream Identity Int -> Stream Identity Int

524readInstance src =

525 let r = P.reads ("fromList [1"

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

527 in case r of

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

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

530

531{-# INLINE pureFoldl' #-}

532pureFoldl' :: Stream Identity Int -> Int

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

534

535{-# INLINE foldableFoldl' #-}

536foldableFoldl' :: Stream Identity Int -> Int

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

538

539{-# INLINE foldableSum #-}

540foldableSum :: Stream Identity Int -> Int

541foldableSum = P.sum

542

543{-# INLINE traversableMapM #-}

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

545traversableMapM = P.mapM return