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

git.iko.soy/streamly

on efecb26 help sign in

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

938 lines 32 kB history raw

1-- |

2-- Module : Streamly.Benchmark.Data.StreamK

4--

5-- License : BSD3

6-- Maintainer : streamly@composewell.com

8{-# LANGUAGE CPP #-}

9{-# LANGUAGE FlexibleContexts #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# OPTIONS_GHC -Wno-orphans #-}

13#ifdef __HADDOCK_VERSION__

14#undef INSPECTION

15#endif

17#ifdef INSPECTION

18{-# LANGUAGE TemplateHaskell #-}

19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20#endif

22module Main (main) where

24-- import Control.Applicative (liftA2)

25-- import Control.Monad (when)

26-- import Data.Maybe (isJust)

27-- import System.Random (randomRIO)

28import Prelude hiding

29 ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate

30 , repeat, replicate

31 )

33import qualified Prelude as P

34-- import qualified Data.List as List

36import qualified Streamly.Internal.Data.StreamK as S

37import qualified Streamly.Internal.Data.Stream as D

38import qualified Streamly.Internal.Data.Fold as Fold

40import Gauge (bgroup, Benchmark, defaultMain)

42import Streamly.Benchmark.Common

44#ifdef INSPECTION

45import Test.Inspection

46#endif

48-------------------------------------------------------------------------------

49-- Stream generation and elimination

50-------------------------------------------------------------------------------

52type Stream m a = S.Stream m a

54{-# INLINE unfoldrD #-}

55unfoldrD :: Monad m => Int -> Int -> Stream m Int

56unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)

57 where

58 step cnt =

59 if cnt > n + streamLen

60 then Nothing

61 else Just (cnt, cnt + 1)

63{-# INLINE unfoldrMD #-}

64unfoldrMD :: Monad m => Int -> Int -> Stream m Int

65unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)

66 where

67 step cnt =

68 if cnt > n + streamLen

69 then return Nothing

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

72{-

73{-# INLINE unfoldrK #-}

74unfoldrK :: Int -> Int -> Stream m Int

75unfoldrK streamLen n = S.unfoldr step n

76 where

77 step cnt =

78 if cnt > n + streamLen

79 then Nothing

80 else Just (cnt, cnt + 1)

81-}

83{-# INLINE unfoldrMK #-}

84unfoldrMK :: Monad m => Int -> Int -> Stream m Int

85unfoldrMK streamLen n = S.unfoldrMWith S.consM step n

86 where

87 step cnt =

88 if cnt > n + streamLen

89 then return Nothing

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

92{-# INLINE repeat #-}

93repeat :: Monad m => Int -> Int -> Stream m Int

94repeat streamLen = S.take streamLen . D.toStreamK . D.repeat

96{-# INLINE repeatM #-}

97repeatM :: Monad m => Int -> Int -> Stream m Int

98repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return

100{-# INLINE replicate #-}

101replicate :: Monad m => Int -> Int -> Stream m Int

102replicate x y = D.toStreamK $ D.replicate x y

103

104{-# INLINE replicateM #-}

105replicateM :: Monad m => Int -> Int -> Stream m Int

106replicateM streamLen = D.toStreamK . D.replicateM streamLen . return

107

108{-# INLINE iterate #-}

109iterate :: Monad m => Int -> Int -> Stream m Int

110iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)

111

112{-# INLINE iterateM #-}

113iterateM :: Monad m => Int -> Int -> Stream m Int

114iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return

115

116{-# INLINE fromFoldable #-}

117fromFoldable :: Int -> Int -> Stream m Int

118fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]

119

120{-# INLINE fromFoldableM #-}

121fromFoldableM :: Monad m => Int -> Int -> Stream m Int

122fromFoldableM streamLen n =

123 Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])

124

125{-

126{-# INLINABLE concatMapFoldableWith #-}

127concatMapFoldableWith :: Foldable f

128 => (Stream m b -> Stream m b -> Stream m b)

129 -> (a -> Stream m b)

130 -> f a

131 -> Stream m b

132concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil

133-}

134

135{-# INLINE concatMapFoldableSerial #-}

136concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int

137concatMapFoldableSerial streamLen n =

138 D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]

139

140{-# INLINE concatMapFoldableSerialM #-}

141concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int

142concatMapFoldableSerialM streamLen n =

143 -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]

144 D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]

145

146-------------------------------------------------------------------------------

147-- Elimination

148-------------------------------------------------------------------------------

149

150{-# INLINE drainD #-}

151drainD :: Monad m => Stream m a -> m ()

152drainD = D.drain . D.fromStreamK

153

154{-# INLINE drain #-}

155drain :: Monad m => Stream m a -> m ()

156drain = S.drain

157

158{-# INLINE mapM_ #-}

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

160mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s

161

162{-

163{-# INLINE uncons #-}

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

165uncons s = do

166 r <- D.uncons $ D.fromStreamK s

167 case r of

168 Nothing -> return ()

169 Just (_, t) -> uncons (D.toStreamK t)

170

171{-# INLINE init #-}

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

173init s = do

174 t <- S.init s

175 P.mapM_ S.drain t

176

177{-# INLINE tail #-}

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

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

180

181{-# INLINE nullTail #-}

182nullTail :: Monad m => Stream m Int -> m ()

183nullTail s = do

184 r <- S.null s

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

186

187{-# INLINE headTail #-}

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

189headTail s = do

190 h <- S.head s

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

192-}

193

194{-# INLINE toList #-}

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

196toList = D.fold Fold.toList . D.fromStreamK

197

198{-# INLINE foldl' #-}

199foldl' :: Monad m => Stream m Int -> m Int

200foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK

201

202{-# INLINE last #-}

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

204last = D.fold Fold.latest . D.fromStreamK

205

206-------------------------------------------------------------------------------

207-- Transformation

208-------------------------------------------------------------------------------

209

210{-# INLINE composeN #-}

211composeN

212 :: Monad m

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

214composeN n f =

215 case n of

216 1 -> drain . f

217 2 -> drain . f . f

218 3 -> drain . f . f . f

219 4 -> drain . f . f . f . f

220 _ -> undefined

221

222{-# INLINE scanl' #-}

223scanl' :: Monad m => Int -> Stream m Int -> m ()

224scanl' n =

225 composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)

226

227{-# INLINE map #-}

228map :: Monad m => Int -> Stream m Int -> m ()

229map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)

230

231{-

232{-# INLINE fmapK #-}

233fmapK :: Monad m => Int -> Stream m Int -> m ()

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

235-}

236

237{-# INLINE mapM #-}

238mapM :: Monad m => Int -> Stream m Int -> m ()

239mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)

240

241{-

242{-# INLINE mapMSerial #-}

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

244mapMSerial n = composeN n $ S.mapMSerial return

245-}

246

247{-# INLINE filterEven #-}

248filterEven :: Monad m => Int -> Stream m Int -> m ()

249filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)

250

251{-

252{-# INLINE filterAllOut #-}

253filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()

254filterAllOut streamLen n = composeN n $ S.filter (> streamLen)

255

256{-# INLINE filterAllIn #-}

257filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()

258filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)

259

260{-# INLINE _takeOne #-}

261_takeOne :: Monad m => Int -> Stream m Int -> m ()

262_takeOne n = composeN n $ S.take 1

263

264{-# INLINE takeAll #-}

265takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()

266takeAll streamLen n = composeN n $ S.take streamLen

267

268{-# INLINE takeWhileTrue #-}

269takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()

270takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)

271

272{-# INLINE dropOne #-}

273dropOne :: Monad m => Int -> Stream m Int -> m ()

274dropOne n = composeN n $ S.drop 1

275

276{-# INLINE dropAll #-}

277dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()

278dropAll streamLen n = composeN n $ S.drop streamLen

279

280{-# INLINE dropWhileTrue #-}

281dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()

282dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)

283

284{-# INLINE dropWhileFalse #-}

285dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()

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

287-}

288

289{-

290{-# INLINE foldrS #-}

291foldrS :: Monad m => Int -> Stream m Int -> m ()

292foldrS n = composeN n $ S.foldrS S.cons S.nil

293

294{-# INLINE foldlS #-}

295foldlS :: Monad m => Int -> Stream m Int -> m ()

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

297-}

298

299{-

300{-# INLINE intersperse #-}

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

302intersperse streamLen n = composeN n $ S.intersperse streamLen

303-}

304

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

306-- Iteration

307-------------------------------------------------------------------------------

308

309{-

310{-# INLINE iterateSource #-}

311iterateSource

312 :: S.MonadAsync m

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

314iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)

315 where

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

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

318

319-- this is quadratic

320{-# INLINE iterateScan #-}

321iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int

322iterateScan iterStreamLen maxIters =

323 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)

324

325-- this is quadratic

326{-# INLINE iterateDropWhileFalse #-}

327iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int

328iterateDropWhileFalse streamLen iterStreamLen maxIters =

329 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)

330

331{-# INLINE iterateMapM #-}

332iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int

333iterateMapM iterStreamLen =

334 iterateSource iterStreamLen (S.mapMWith S.consM return)

335

336{-# INLINE iterateFilterEven #-}

337iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int

338iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)

339

340{-# INLINE iterateTakeAll #-}

341iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int

342iterateTakeAll streamLen iterStreamLen =

343 iterateSource iterStreamLen (S.take streamLen)

344

345{-# INLINE iterateDropOne #-}

346iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int

347iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)

348

349{-# INLINE iterateDropWhileTrue #-}

350iterateDropWhileTrue :: S.MonadAsync m =>

351 Int -> Int -> Int -> Int -> Stream m Int

352iterateDropWhileTrue streamLen iterStreamLen =

353 iterateSource iterStreamLen (S.dropWhile (<= streamLen))

354-}

355

356-------------------------------------------------------------------------------

357-- Zipping

358-------------------------------------------------------------------------------

359

360{-

361{-# INLINE zipWith #-}

362zipWith :: Monad m => Stream m Int -> m ()

363zipWith src = drain $ S.zipWith (,) src src

364

365{-# INLINE zipWithM #-}

366zipWithM :: Monad m => Stream m Int -> m ()

367zipWithM src = drain $ S.zipWithM (curry return) src src

368

369{-# INLINE sortByK #-}

370sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a

371sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure

372

373{-# INLINE sortBy #-}

374sortBy :: Monad m => Stream m Int -> m ()

375sortBy = drain . sortByK compare

376

377-------------------------------------------------------------------------------

378-- Mixed Composition

379-------------------------------------------------------------------------------

380

381{-# INLINE scanMap #-}

382scanMap :: Monad m => Int -> Stream m Int -> m ()

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

384

385{-# INLINE dropMap #-}

386dropMap :: Monad m => Int -> Stream m Int -> m ()

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

388

389{-# INLINE dropScan #-}

390dropScan :: Monad m => Int -> Stream m Int -> m ()

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

392

393{-# INLINE takeDrop #-}

394takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()

395takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen

396

397{-# INLINE takeScan #-}

398takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()

399takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen

400

401{-# INLINE takeMap #-}

402takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()

403takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen

404

405{-# INLINE filterDrop #-}

406filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()

407filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)

408

409{-# INLINE filterTake #-}

410filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()

411filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)

412

413{-# INLINE filterScan #-}

414filterScan :: Monad m => Int -> Stream m Int -> m ()

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

416

417{-# INLINE filterMap #-}

418filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()

419filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)

420-}

421

422-------------------------------------------------------------------------------

423-- ConcatMap

424-------------------------------------------------------------------------------

425

426-- concatMap unfoldrM/unfoldrM

427

428{-# INLINE concatMap #-}

429concatMap :: Int -> Int -> Int -> IO ()

430concatMap outer inner n =

431 S.drain $ D.toStreamK $ D.concatMap

432 (\_ -> D.fromStreamK $ unfoldrMK inner n)

433 (D.fromStreamK $ unfoldrMK outer n)

434

435#ifdef INSPECTION

436inspect $ hasNoTypeClasses 'concatMap

437#endif

438

439-- concatMap unfoldr/unfoldr

440

441{-

442{-# INLINE concatMapPure #-}

443concatMapPure :: Int -> Int -> Int -> IO ()

444concatMapPure outer inner n =

445 S.drain $ S.concatMap

446 (\_ -> unfoldr inner n)

447 (unfoldr outer n)

448

449#ifdef INSPECTION

450inspect $ hasNoTypeClasses 'concatMapPure

451#endif

452

453-- concatMap replicate/unfoldrM

454

455{-# INLINE concatMapRepl #-}

456concatMapRepl :: Int -> Int -> Int -> IO ()

457concatMapRepl outer inner n =

458 S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)

459

460#ifdef INSPECTION

461inspect $ hasNoTypeClasses 'concatMapRepl

462#endif

463

464-- concatMapWith

465

466{-# INLINE sourceConcatMapId #-}

467sourceConcatMapId :: Monad m

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

469sourceConcatMapId val n =

470 S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]

471

472{-# INLINE concatMapBySerial #-}

473concatMapBySerial :: Int -> Int -> Int -> IO ()

474concatMapBySerial outer inner n =

475 S.drain $ S.concatMapWith S.serial

476 (unfoldrM inner)

477 (unfoldrM outer n)

478-}

479

480{-

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

482-- Nested Composition

483-------------------------------------------------------------------------------

484

485instance Monad m => Applicative (S.Stream m) where

486 {-# INLINE pure #-}

487 pure = S.fromPure

488

489 {-# INLINE (<*>) #-}

490 (<*>) = S.crossApply

491

492 {-# INLINE liftA2 #-}

493 liftA2 f x = (<*>) (fmap f x)

494

495 {-# INLINE (*>) #-}

496 (*>) = S.crossApplySnd

497

498 {-# INLINE (<*) #-}

499 (<*) = S.crossApplyFst

500

501-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,

502-- the monad instance of StreamD is slower than StreamK after foldr/build

503-- fusion.

504instance Monad m => Monad (S.Stream m) where

505 {-# INLINE return #-}

506 return = pure

507

508 {-# INLINE (>>=) #-}

509 (>>=) = flip S.concatMap

510

511{-# INLINE drainApplicative #-}

512drainApplicative :: Monad m => Stream m Int -> m ()

513drainApplicative s = drain $ do

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

515

516{-# INLINE drainMonad #-}

517drainMonad :: Monad m => Stream m Int -> m ()

518drainMonad s = drain $ do

519 x <- s

520 y <- s

521 return $ x + y

522

523{-# INLINE drainMonad3 #-}

524drainMonad3 :: Monad m => Stream m Int -> m ()

525drainMonad3 s = drain $ do

526 x <- s

527 y <- s

528 z <- s

529 return $ x + y + z

530

531{-# INLINE filterAllOutMonad #-}

532filterAllOutMonad

533 :: Monad m

534 => Stream m Int -> m ()

535filterAllOutMonad str = drain $ do

536 x <- str

537 y <- str

538 let s = x + y

539 if s < 0

540 then return s

541 else S.nil

542

543{-# INLINE filterAllInMonad #-}

544filterAllInMonad

545 :: Monad m

546 => Stream m Int -> m ()

547filterAllInMonad str = drain $ do

548 x <- str

549 y <- str

550 let s = x + y

551 if s > 0

552 then return s

553 else S.nil

554

555-------------------------------------------------------------------------------

556-- Nested Composition Pure lists

557-------------------------------------------------------------------------------

558

559-- There are several list benchmarks here for comparison with lists. It is easy

560-- and convenient to see the comparisons when they are here, otherwise we'll

561-- have to add a separate module for list benchmarks with the same names and

562-- then add a comparison in bench.sh.

563

564{-# INLINE unfoldrList #-}

565unfoldrList :: Int -> Int -> [Int]

566unfoldrList maxval n = List.unfoldr step n

567 where

568 step cnt =

569 if cnt > n + maxval

570 then Nothing

571 else Just (cnt, cnt + 1)

572

573{-# INLINE toNullApNestedList #-}

574toNullApNestedList :: [Int] -> [Int]

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

576

577{-# INLINE toNullNestedList #-}

578toNullNestedList :: [Int] -> [Int]

579toNullNestedList s = do

580 x <- s

581 y <- s

582 return $ x + y

583

584{-# INLINE toNullNestedList3 #-}

585toNullNestedList3 :: [Int] -> [Int]

586toNullNestedList3 s = do

587 x <- s

588 y <- s

589 z <- s

590 return $ x + y + z

591

592{-# INLINE filterAllOutNestedList #-}

593filterAllOutNestedList :: [Int] -> [Int]

594filterAllOutNestedList str = do

595 x <- str

596 y <- str

597 let s = x + y

598 if s < 0

599 then return s

600 else []

601

602{-# INLINE filterAllInNestedList #-}

603filterAllInNestedList :: [Int] -> [Int]

604filterAllInNestedList str = do

605 x <- str

606 y <- str

607 let s = x + y

608 if s > 0

609 then return s

610 else []

611 -}

612

613-------------------------------------------------------------------------------

614-- Benchmarks

615-------------------------------------------------------------------------------

616

617moduleName :: String

618moduleName = "Data.Stream.ToStreamK"

619

620-- Generation of StreamK using StreamD generation functions and eleminating

621-- using StreamK drain.

622o_1_space_generation :: Int -> Benchmark

623o_1_space_generation streamLen =

624 bgroup "generation"

625 [ benchFold "unfoldr" drain (unfoldrD streamLen)

626 , benchFold "unfoldrM" drain (unfoldrMD streamLen)

627 , benchFold "repeat" drain (repeat streamLen)

628 , benchFold "repeatM" drain (repeatM streamLen)

629 , benchFold "replicate" drain (replicate streamLen)

630 , benchFold "replicateM" drain (replicateM streamLen)

631 , benchFold "iterate" drain (iterate streamLen)

632 , benchFold "iterateM" drain (iterateM streamLen)

633

634 , benchFold "fromFoldable" drain (fromFoldable streamLen)

635 , benchFold "fromFoldableM" drain (fromFoldableM streamLen)

636

637 -- appends

638 , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)

639 , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)

640 ]

641

642-- Generating using StreamK and eliminating using StreamD folds.

643o_1_space_elimination :: Int -> Benchmark

644o_1_space_elimination streamLen =

645 bgroup "elimination"

646 [ benchFold "toNull" drainD (unfoldrMK streamLen)

647 , benchFold "mapM_" mapM_ (unfoldrMK streamLen)

648 -- , benchFold "uncons" uncons (unfoldrMK streamLen)

649 -- , benchFold "init" init (unfoldrM streamLen)

650 , benchFold "foldl'" foldl' (unfoldrMK streamLen)

651 , benchFold "last" last (unfoldrMK streamLen)

652 ]

653

654{-

655o_1_space_nested :: Int -> Benchmark

656o_1_space_nested streamLen =

657 bgroup "nested"

658 [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)

659 , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)

660 , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)

661 , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)

662 , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)

663 , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)

664 , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)

665 , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)

666 , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)

667 , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)

668 ]

669 where

670 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop

671 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop

672-}

673

674-- Generate using StreamK and transform using StreamD transformation functions

675-- and then drain using StreamK.

676o_1_space_transformation :: Int -> Benchmark

677o_1_space_transformation streamLen =

678 bgroup "transformation"

679 [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)

680 benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)

681 , benchFold "map" (map 1) (unfoldrMK streamLen)

682 -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)

683 , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)

684 -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)

685 ]

686

687o_1_space_transformationX4 :: Int -> Benchmark

688o_1_space_transformationX4 streamLen =

689 bgroup "transformationX4"

690 [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)

691 , benchFold "map" (map 4) (unfoldrMK streamLen)

692 -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)

693 , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)

694 -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)

695 -- XXX this is horribly slow

696 -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)

697 ]

698

699-- Generate using K, fold using K, concat using D.concatMap

700o_1_space_concat :: Int -> Benchmark

701o_1_space_concat streamLen =

702 bgroup "concat"

703 [ {- benchIOSrc1 "concatMapPure (n of 1)"

704 (concatMapPure streamLen 1)

705 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"

706 (concatMapPure streamLen2 streamLen2)

707 , benchIOSrc1 "concatMapPure (1 of n)"

708 (concatMapPure 1 streamLen)

709 -}

710

711 benchIOSrc1 "concatMap (n of 1)"

712 (concatMap streamLen 1)

713 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"

714 (concatMap streamLen2 streamLen2)

715 , benchIOSrc1 "concatMap (1 of n)"

716 (concatMap 1 streamLen)

717

718{-

719 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"

720 (concatMapRepl streamLen2 streamLen2)

721

722 -- This is for comparison with concatMapFoldableWith

723 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"

724 (S.drain

725 . S.concatMapWith S.serial id

726 . sourceConcatMapId streamLen)

727

728 , benchIOSrc1 "concatMapBy serial (n of 1)"

729 (concatMapBySerial streamLen 1)

730 , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"

731 (concatMapBySerial streamLen2 streamLen2)

732 , benchIOSrc1 "concatMapBy serial (1 of n)"

733 (concatMapBySerial 1 streamLen)

734 , benchFold "sortBy" sortBy (unfoldrM streamLen)

735 -}

736 ]

737 where

738 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop

739

740o_1_space_filtering :: Int -> Benchmark

741o_1_space_filtering streamLen =

742 bgroup "filtering"

743 [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)

744 {-

745 , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)

746 , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)

747 , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)

748 , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)

749 , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)

750 , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)

751 , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)

752 , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)

753 -}

754 ]

755

756o_1_space_filteringX4 :: Int -> Benchmark

757o_1_space_filteringX4 streamLen =

758 bgroup "filteringX4"

759 [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)

760 {-

761 , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)

762 , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)

763 , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)

764 , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)

765 , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)

766 , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)

767 , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)

768 , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)

769 -}

770 ]

771

772{-

773o_1_space_zipping :: Int -> Benchmark

774o_1_space_zipping streamLen =

775 bgroup "zipping"

776 [ benchFold "zipWith" zipWith (unfoldrM streamLen)

777 , benchFold "zipWithM" zipWithM (unfoldrM streamLen)

778 ]

779

780o_1_space_mixed :: Int -> Benchmark

781o_1_space_mixed streamLen =

782 bgroup "mixed"

783 [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)

784 , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)

785 , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)

786 , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)

787 , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)

788 , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)

789 , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)

790 , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)

791 , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)

792 , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)

793 ]

794

795o_1_space_mixedX2 :: Int -> Benchmark

796o_1_space_mixedX2 streamLen =

797 bgroup "mixedX2"

798 [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)

799 , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)

800 , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)

801 , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)

802 , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)

803 , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)

804 , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)

805 , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)

806 , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)

807 , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)

808 ]

809

810o_1_space_mixedX4 :: Int -> Benchmark

811o_1_space_mixedX4 streamLen =

812 bgroup "mixedX4"

813 [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)

814 , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)

815 , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)

816 , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)

817 , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)

818 , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)

819 , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)

820 , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)

821 , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)

822 , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)

823 ]

824 -}

825

826{-

827o_1_space_list :: Int -> Benchmark

828o_1_space_list streamLen =

829 bgroup "list"

830 [ bgroup "elimination"

831 [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)

832 ]

833 , bgroup "nested"

834 [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)

835 , benchList "toNull" toNullNestedList (unfoldrList streamLen2)

836 , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)

837 , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)

838 , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)

839 ]

840 ]

841 where

842

843 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop

844 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop

845-}

846

847o_1_space :: Int -> Benchmark

848o_1_space streamLen =

849 bgroup (o_1_space_prefix moduleName)

850 [ o_1_space_generation streamLen

851 , o_1_space_elimination streamLen

852 -- , o_1_space_nested streamLen

853 , o_1_space_transformation streamLen

854 , o_1_space_transformationX4 streamLen

855 , o_1_space_concat streamLen

856 , o_1_space_filtering streamLen

857 , o_1_space_filteringX4 streamLen

858 -- , o_1_space_zipping streamLen

859 -- , o_1_space_mixed streamLen

860 -- , o_1_space_mixedX2 streamLen

861 -- , o_1_space_mixedX4 streamLen

862 -- , o_1_space_list streamLen

863 ]

864

865{-

866o_n_heap :: Int -> Benchmark

867o_n_heap streamLen =

868 bgroup (o_n_heap_prefix moduleName)

869 [ bgroup "transformation"

870 [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)

871 ]

872 ]

873

874{-# INLINE benchK #-}

875benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark

876benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f

877

878o_n_stack :: Int -> Int -> Int -> Benchmark

879o_n_stack streamLen iterStreamLen maxIters =

880 bgroup (o_n_stack_prefix moduleName)

881 [ bgroup "elimination"

882 [ benchFold "tail" tail (unfoldrM streamLen)

883 , benchFold "nullTail" nullTail (unfoldrM streamLen)

884 , benchFold "headTail" headTail (unfoldrM streamLen)

885 ]

886 , bgroup "transformation"

887 [

888 -- XXX why do these need so much stack

889 benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)

890 , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)

891 ]

892 , bgroup "transformationX4"

893 [

894 benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)

895 ]

896 , bgroup "iterated"

897 [ benchK "mapM" (iterateMapM iterStreamLen maxIters)

898 , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)

899 , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)

900 , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)

901 , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)

902 , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)

903 , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)

904 ]

905 ]

906 where

907 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop

908 streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop

909-}

910

911o_n_space :: Int -> Benchmark

912o_n_space streamLen =

913 bgroup (o_n_space_prefix moduleName)

914 [ bgroup "elimination"

915 [ benchFold "toList" toList (unfoldrMK streamLen)

916 ]

917 ]

918

919{-

920{-# INLINE benchList #-}

921benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark

922benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f

923-}

924

925main :: IO ()

926main =

927 defaultMain

928 [ o_1_space streamLen

929 -- , o_n_stack streamLen iterStreamLen maxIters

930 -- , o_n_heap streamLen

931 , o_n_space streamLen

932 ]

933

934 where

935

936 streamLen = 100000

937 -- maxIters = 10000

938 -- iterStreamLen = 10