benchmark/Streamly/Benchmark/Data/Unfold.hs · streamly

git.iko.soy/streamly

on efecb26 help sign in

streamly/benchmark/Streamly/Benchmark/Data/Unfold.hs

856 lines 27 kB history raw

1-- |

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

4-- License : MIT

5-- Maintainer : streamly@composewell.com

7{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE CPP #-}

9{-# LANGUAGE ScopedTypeVariables #-}

11#ifdef __HADDOCK_VERSION__

12#undef INSPECTION

13#endif

15#ifdef INSPECTION

16{-# LANGUAGE TemplateHaskell #-}

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

18#endif

20module Main (main) where

22import Control.DeepSeq (NFData(..))

23import Control.Exception (SomeException, ErrorCall, try)

24import Data.Char (ord)

25import Data.Word (Word8)

26import Streamly.Internal.Data.Unfold (Unfold)

27import System.IO (Handle, hClose)

28import System.Random (randomRIO)

30import qualified Prelude

31import qualified Streamly.FileSystem.Handle as FH

32import qualified Streamly.Internal.Data.Fold as FL

33import qualified Streamly.Internal.Data.Unfold as UF

34import qualified Streamly.Internal.Data.Unfold.Exception as UF

35import qualified Streamly.Internal.Data.Stream as S

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

37import qualified Streamly.Internal.Data.StreamK as K

39import Gauge hiding (env)

40import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile)

41import Streamly.Benchmark.Common

42import Streamly.Benchmark.Common.Handle

44#ifdef INSPECTION

45import Control.Monad.Catch (MonadCatch)

46import Test.Inspection

47#endif

49{-# INLINE benchIO #-}

50benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark

51benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f

53-------------------------------------------------------------------------------

54-- Stream generation and elimination

55-------------------------------------------------------------------------------

57-- generate numbers up to the argument value

58{-# INLINE source #-}

59source :: Monad m => Int -> Unfold m Int Int

60source n = UF.second n UF.enumerateFromToIntegral

62-------------------------------------------------------------------------------

63-- Benchmark helpers

64-------------------------------------------------------------------------------

66{-# INLINE drainGeneration #-}

67drainGeneration :: Monad m => Unfold m a b -> a -> m ()

68drainGeneration unf seed = UF.fold FL.drain unf seed

70{-# INLINE drainTransformation #-}

71drainTransformation ::

72 Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()

73drainTransformation unf f seed = drainGeneration (f unf) seed

75{-# INLINE drainTransformationDefault #-}

76drainTransformationDefault ::

77 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()

78drainTransformationDefault to =

79 drainTransformation (UF.second to UF.enumerateFromToIntegral)

81{-# INLINE drainProduct #-}

82drainProduct ::

83 Monad m

84 => Unfold m a b

85 -> Unfold m c d

86 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)

87 -> e

88 -> m ()

89drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed

91{-# INLINE drainProductDefault #-}

92drainProductDefault ::

93 Monad m

94 => Int

95 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)

96 -> e

97 -> m ()

98drainProductDefault to = drainProduct src src

100 where

101

102 src = UF.second to UF.enumerateFromToIntegral

103

104-------------------------------------------------------------------------------

105-- Operations on input

106-------------------------------------------------------------------------------

107

108{-# INLINE lmap #-}

109lmap :: Monad m => Int -> Int -> m ()

110lmap size start =

111 drainTransformationDefault (size + start) (UF.lmap (+ 1)) start

112

113{-# INLINE lmapM #-}

114lmapM :: Monad m => Int -> Int -> m ()

115lmapM size start =

116 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start

117

118{-# INLINE both #-}

119both :: Monad m => Int -> Int -> m ()

120both size start =

121 drainTransformationDefault (size + start) (UF.both start) undefined

122

123

124{-# INLINE first #-}

125first :: Monad m => Int -> Int -> m ()

126first size start =

127 drainTransformation

128 (UF.take size UF.enumerateFromThenIntegral)

129 (UF.first start)

130 1

131

132{-# INLINE second #-}

133second :: Monad m => Int -> Int -> m ()

134second size start =

135 drainTransformation

136 (UF.take size UF.enumerateFromThenIntegral)

137 (UF.second 1)

138 start

139

140{-# INLINE discardFirst #-}

141discardFirst :: Monad m => Int -> Int -> m ()

142discardFirst size start =

143 drainTransformationDefault (size + start) UF.discardFirst (start, start)

144

145{-# INLINE discardSecond #-}

146discardSecond :: Monad m => Int -> Int -> m ()

147discardSecond size start =

148 drainTransformationDefault (size + start) UF.discardSecond (start, start)

149

150{-# INLINE swap #-}

151swap :: Monad m => Int -> Int -> m ()

152swap size start =

153 drainTransformation

154 (UF.take size UF.enumerateFromThenIntegral)

155 UF.swap

156 (1, start)

157

158-------------------------------------------------------------------------------

159-- Stream generation

160-------------------------------------------------------------------------------

161

162{-# INLINE fromStream #-}

163fromStream :: Int -> Int -> IO ()

164fromStream size start =

165 drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)

166

167-- XXX INVESTIGATE: Although the performance of this should be equivalant to

168-- fromStream, this is considerably worse. More than 4x worse.

169{-# INLINE fromStreamK #-}

170fromStreamK :: Monad m => Int -> Int -> m ()

171fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)

172

173{-# INLINE fromStreamD #-}

174fromStreamD :: Monad m => Int -> Int -> m ()

175fromStreamD size start =

176 drainGeneration UF.fromStreamD (D.replicate size start)

177

178{-# INLINE _nilM #-}

179_nilM :: Monad m => Int -> Int -> m ()

180_nilM _ start = drainGeneration (UF.nilM return) start

181

182{-# INLINE consM #-}

183consM :: Monad m => Int -> Int -> m ()

184consM size start =

185 drainTransformationDefault (size + start) (UF.consM return) start

186

187{-# INLINE _functionM #-}

188_functionM :: Monad m => Int -> Int -> m ()

189_functionM _ start = drainGeneration (UF.functionM return) start

190

191{-# INLINE _function #-}

192_function :: Monad m => Int -> Int -> m ()

193_function _ start = drainGeneration (UF.function id) start

194

195{-# INLINE _identity #-}

196_identity :: Monad m => Int -> Int -> m ()

197_identity _ start = drainGeneration UF.identity start

198

199{-# INLINE _const #-}

200_const :: Monad m => Int -> Int -> m ()

201_const size start =

202 drainGeneration (UF.take size (UF.fromEffect (return start))) undefined

203

204{-# INLINE unfoldrM #-}

205unfoldrM :: Monad m => Int -> Int -> m ()

206unfoldrM size start = drainGeneration (UF.unfoldrM step) start

207

208 where

209

210 step i =

211 return

212 $ if i < start + size

213 then Just (i, i + 1)

214 else Nothing

215

216{-# INLINE fromList #-}

217fromList :: Monad m => Int -> Int -> m ()

218fromList size start = drainGeneration UF.fromList [start .. start + size]

219

220{-# INLINE fromListM #-}

221fromListM :: Monad m => Int -> Int -> m ()

222fromListM size start =

223 drainGeneration UF.fromListM (Prelude.map return [start .. start + size])

224

225{-# INLINE _fromSVar #-}

226_fromSVar :: Int -> Int -> m ()

227_fromSVar = undefined

228

229{-# INLINE _fromProducer #-}

230_fromProducer :: Int -> Int -> m ()

231_fromProducer = undefined

232

233{-# INLINE replicateM #-}

234replicateM :: Monad m => Int -> Int -> m ()

235replicateM size start = drainGeneration UF.replicateM (size, return start)

236

237{-# INLINE repeatM #-}

238repeatM :: Monad m => Int -> Int -> m ()

239repeatM size start = drainGeneration (UF.take size UF.repeatM) (return start)

240

241{-# INLINE iterateM #-}

242iterateM :: Monad m => Int -> Int -> m ()

243iterateM size start =

244 drainGeneration (UF.take size (UF.iterateM return)) (return start)

245

246{-# INLINE fromIndicesM #-}

247fromIndicesM :: Monad m => Int -> Int -> m ()

248fromIndicesM size start =

249 drainGeneration (UF.take size (UF.fromIndicesM return)) start

250

251{-# INLINE enumerateFromThenIntegral #-}

252enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()

253enumerateFromThenIntegral size start =

254 drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)

255

256{-# INLINE enumerateFromToIntegral #-}

257enumerateFromToIntegral :: Monad m => Int -> Int -> m ()

258enumerateFromToIntegral size start =

259 drainGeneration

260 ( UF.second

261 (size + start)

262 UF.enumerateFromToIntegral

263 ) start

264

265{-# INLINE enumerateFromIntegral #-}

266enumerateFromIntegral :: Monad m => Int -> Int -> m ()

267enumerateFromIntegral size start =

268 drainGeneration (UF.take size UF.enumerateFromIntegral) start

269

270{-# INLINE enumerateFromStepNum #-}

271enumerateFromStepNum :: Monad m => Int -> Int -> m ()

272enumerateFromStepNum size start =

273 drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)

274

275{-# INLINE enumerateFromNum #-}

276enumerateFromNum :: Monad m => Int -> Int -> m ()

277enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start

278

279{-# INLINE enumerateFromToFractional #-}

280enumerateFromToFractional :: Monad m => Int -> Int -> m ()

281enumerateFromToFractional size start =

282 let intToDouble x = (fromInteger (fromIntegral x)) :: Double

283 in drainGeneration

284 ( UF.second

285 (intToDouble $ start + size)

286 UF.enumerateFromToFractional

287 )

288 (intToDouble start)

289

290-------------------------------------------------------------------------------

291-- Stream transformation

292-------------------------------------------------------------------------------

293

294{-# INLINE postscan #-}

295postscan :: Monad m => Int -> Int -> m ()

296postscan size start =

297 drainTransformationDefault (size + start) (UF.postscan FL.sum) start

298

299{-# INLINE map #-}

300map :: Monad m => Int -> Int -> m ()

301map size start = drainTransformationDefault (size + start) (UF.map (+1)) start

302

303{-# INLINE mapM #-}

304mapM :: Monad m => Int -> Int -> m ()

305mapM size start =

306 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start

307

308{-# INLINE mapM2 #-}

309mapM2 :: Monad m => Int -> Int -> m ()

310mapM2 size start =

311 drainTransformationDefault

312 size

313 (UF.mapM2 (\a b -> return $ a + b))

314 start

315

316-------------------------------------------------------------------------------

317-- Stream filtering

318-------------------------------------------------------------------------------

319

320{-# INLINE takeWhileM #-}

321takeWhileM :: Monad m => Int -> Int -> m ()

322takeWhileM size start =

323 drainTransformationDefault

324 size

325 (UF.takeWhileM (\b -> return (b <= size + start)))

326 start

327

328{-# INLINE takeWhile #-}

329takeWhile :: Monad m => Int -> Int -> m ()

330takeWhile size start =

331 drainTransformationDefault

332 size

333 (UF.takeWhile (\b -> b <= size + start))

334 start

335

336{-# INLINE take #-}

337take :: Monad m => Int -> Int -> m ()

338take size start = drainTransformationDefault (size + start) (UF.take size) start

339

340{-# INLINE filter #-}

341filter :: Monad m => Int -> Int -> m ()

342filter size start =

343 drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start

344

345{-# INLINE filterM #-}

346filterM :: Monad m => Int -> Int -> m ()

347filterM size start =

348 drainTransformationDefault

349 (size + start)

350 (UF.filterM (\_ -> (return True)))

351 start

352

353{-# INLINE _dropOne #-}

354_dropOne :: Monad m => Int -> Int -> m ()

355_dropOne size start =

356 drainTransformationDefault (size + start) (UF.drop 1) start

357

358{-# INLINE dropAll #-}

359dropAll :: Monad m => Int -> Int -> m ()

360dropAll size start =

361 drainTransformationDefault (size + start) (UF.drop (size + 1)) start

362

363{-# INLINE dropWhileTrue #-}

364dropWhileTrue :: Monad m => Int -> Int -> m ()

365dropWhileTrue size start =

366 drainTransformationDefault

367 (size + start)

368 (UF.dropWhileM (\_ -> return True))

369 start

370

371{-# INLINE dropWhileFalse #-}

372dropWhileFalse :: Monad m => Int -> Int -> m ()

373dropWhileFalse size start =

374 drainTransformationDefault

375 (size + start)

376 (UF.dropWhileM (\_ -> return False))

377 start

378

379{-# INLINE dropWhileMTrue #-}

380dropWhileMTrue :: Monad m => Int -> Int -> m ()

381dropWhileMTrue size start =

382 drainTransformationDefault

383 size

384 (UF.dropWhileM (\_ -> return True))

385 start

386

387{-# INLINE dropWhileMFalse #-}

388dropWhileMFalse :: Monad m => Int -> Int -> m ()

389dropWhileMFalse size start =

390 drainTransformationDefault

391 size

392 (UF.dropWhileM (\_ -> return False))

393 start

394

395-------------------------------------------------------------------------------

396-- Stream combination

397-------------------------------------------------------------------------------

398

399{-# INLINE zipWith #-}

400zipWith :: Monad m => Int -> Int -> m ()

401zipWith size start =

402 drainProductDefault (size + start) (UF.zipWith (+)) start

403

404{-# INLINE zipWithM #-}

405zipWithM :: Monad m => Int -> Int -> m ()

406zipWithM size start =

407 drainProductDefault

408 (size + start)

409 (UF.zipWithM (\a b -> return $ a + b))

410 start

411

412{-# INLINE teeZipWith #-}

413teeZipWith :: Monad m => Int -> Int -> m ()

414teeZipWith size start =

415 drainProductDefault (size + start) (UF.zipWith (+)) start

416

417-------------------------------------------------------------------------------

418-- Applicative

419-------------------------------------------------------------------------------

420

421nthRoot :: Double -> Int -> Int

422nthRoot n value = round (fromIntegral value**(1/n))

423

424{-# INLINE toNullAp #-}

425toNullAp :: Monad m => Int -> Int -> m ()

426toNullAp value start =

427 let end = start + nthRoot 2 value

428 s = source end

429 -- in UF.fold ((+) <$> s <*> s) FL.drain start

430 in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start

431

432{-# INLINE _apDiscardFst #-}

433_apDiscardFst :: Int -> Int -> m ()

434_apDiscardFst = undefined

435

436{-# INLINE _apDiscardSnd #-}

437_apDiscardSnd :: Int -> Int -> m ()

438_apDiscardSnd = undefined

439

440-------------------------------------------------------------------------------

441-- Monad

442-------------------------------------------------------------------------------

443

444{-# INLINE concatMapM #-}

445concatMapM :: Monad m => Int -> Int -> m ()

446concatMapM value start =

447 val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start

448

449 where

450

451 val = nthRoot 2 value

452 unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)

453 unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral

454

455{-# INLINE toNull #-}

456toNull :: Monad m => Int -> Int -> m ()

457toNull value start =

458 let end = start + nthRoot 2 value

459 src = source end

460 {-

461 u = do

462 x <- src

463 y <- src

464 return (x + y)

465 -}

466 u = src `UF.bind` \x ->

467 src `UF.bind` \y ->

468 UF.fromPure (x + y)

469 in UF.fold FL.drain u start

470

471

472{-# INLINE toNull3 #-}

473toNull3 :: Monad m => Int -> Int -> m ()

474toNull3 value start =

475 let end = start + nthRoot 3 value

476 src = source end

477 {-

478 u = do

479 x <- src

480 y <- src

481 z <- src

482 return (x + y + z)

483 -}

484 u = src `UF.bind` \x ->

485 src `UF.bind` \y ->

486 UF.fromPure (x + y)

487 in UF.fold FL.drain u start

488

489{-# INLINE toList #-}

490toList :: Monad m => Int -> Int -> m [Int]

491toList value start = do

492 let end = start + nthRoot 2 value

493 src = source end

494 {-

495 u = do

496 x <- src

497 y <- src

498 return (x + y)

499 -}

500 u = src `UF.bind` \x ->

501 src `UF.bind` \y ->

502 UF.fromPure (x + y)

503 in UF.fold FL.toList u start

504

505{-# INLINE toListSome #-}

506toListSome :: Monad m => Int -> Int -> m [Int]

507toListSome value start = do

508 let end = start + nthRoot 2 value

509 src = source end

510 {-

511 u = do

512 x <- src

513 y <- src

514 return (x + y)

515 -}

516 u = src `UF.bind` \x ->

517 src `UF.bind` \y ->

518 UF.fromPure (x + y)

519 in UF.fold FL.toList (UF.take 1000 u) start

520

521{-# INLINE filterAllOut #-}

522filterAllOut :: Monad m => Int -> Int -> m ()

523filterAllOut value start = do

524 let end = start + nthRoot 2 value

525 src = source end

526 {-

527 u = do

528 x <- src

529 y <- src

530 -}

531 u = src `UF.bind` \x ->

532 src `UF.bind` \y ->

533 let s = x + y

534 in if s < 0

535 then UF.fromPure s

536 else UF.nilM (return . const ())

537 in UF.fold FL.drain u start

538

539{-# INLINE filterAllIn #-}

540filterAllIn :: Monad m => Int -> Int -> m ()

541filterAllIn value start = do

542 let end = start + nthRoot 2 value

543 src = source end

544 {-

545 u = do

546 x <- src

547 y <- src

548 -}

549 u = src `UF.bind` \x ->

550 src `UF.bind` \y ->

551 let s = x + y

552 in if s > 0

553 then UF.fromPure s

554 else UF.nilM (return . const ())

555 in UF.fold FL.drain u start

556

557{-# INLINE filterSome #-}

558filterSome :: Monad m => Int -> Int -> m ()

559filterSome value start = do

560 let end = start + nthRoot 2 value

561 src = source end

562 {-

563 u = do

564 x <- src

565 y <- src

566 -}

567 u = src `UF.bind` \x ->

568 src `UF.bind` \y ->

569 let s = x + y

570 in if s > 1100000

571 then UF.fromPure s

572 else UF.nilM (return . const ())

573 in UF.fold FL.drain u start

574

575{-# INLINE breakAfterSome #-}

576breakAfterSome :: Int -> Int -> IO ()

577breakAfterSome value start =

578 let end = start + nthRoot 2 value

579 src = source end

580 {-

581 u = do

582 x <- src

583 y <- src

584 -}

585 u = src `UF.bind` \x ->

586 src `UF.bind` \y ->

587 let s = x + y

588 in if s > 1100000

589 then error "break"

590 else UF.fromPure s

591 in do

592 (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start

593 return ()

594

595-------------------------------------------------------------------------------

596-- Benchmark ops

597-------------------------------------------------------------------------------

598

599-- n * (n + 1) / 2 == linearCount

600concatCount :: Int -> Int

601concatCount linearCount =

602 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)

603

604{-# INLINE many #-}

605many :: Monad m => Int -> Int -> m ()

606many linearCount start = do

607 let end = start + concatCount linearCount

608 UF.fold FL.drain (UF.many (source end) (source end)) start

609

610-------------------------------------------------------------------------------

611-- Benchmarks

612-------------------------------------------------------------------------------

613

614moduleName :: String

615moduleName = "Data.Unfold"

616

617o_1_space_transformation_input :: Int -> [Benchmark]

618o_1_space_transformation_input size =

619 [ bgroup

620 "transformation/input"

621 [ benchIO "lmap" $ lmap size

622 , benchIO "lmapM" $ lmapM size

623 , benchIO "both" $ both size

624 , benchIO "first" $ first size

625 , benchIO "second" $ second size

626 , benchIO "discardFirst" $ discardFirst size

627 , benchIO "discardSecond" $ discardSecond size

628 , benchIO "swap" $ swap size

629 ]

630 ]

631

632o_1_space_generation :: Int -> [Benchmark]

633o_1_space_generation size =

634 [ bgroup

635 "generation"

636 [ benchIO "fromStream" $ fromStream size

637 , benchIO "fromStreamK" $ fromStreamK size

638 , benchIO "fromStreamD" $ fromStreamD size

639 -- Very small benchmarks, reporting in ns

640 -- , benchIO "nilM" $ nilM size

641 , benchIO "consM" $ consM size

642 -- , benchIO "functionM" $ functionM size

643 -- , benchIO "function" $ function size

644 -- , benchIO "identity" $ identity size

645 -- , benchIO "const" $ const size

646 , benchIO "unfoldrM" $ unfoldrM size

647 , benchIO "fromList" $ fromList size

648 , benchIO "fromListM" $ fromListM size

649 -- Unimplemented

650 -- , benchIO "fromSVar" $ fromSVar size

651 -- , benchIO "fromProducer" $ fromProducer size

652 , benchIO "replicateM" $ replicateM size

653 , benchIO "repeatM" $ repeatM size

654 , benchIO "iterateM" $ iterateM size

655 , benchIO "fromIndicesM" $ fromIndicesM size

656 , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size

657 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size

658 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size

659 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size

660 , benchIO "enumerateFromNum" $ enumerateFromNum size

661 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size

662 ]

663 ]

664

665o_1_space_transformation :: Int -> [Benchmark]

666o_1_space_transformation size =

667 [ bgroup

668 "transformation"

669 [ benchIO "map" $ map size

670 , benchIO "mapM" $ mapM size

671 , benchIO "mapM2" $ mapM2 size

672 , benchIO "postscan" $ postscan size

673 ]

674 ]

675

676o_1_space_filtering :: Int -> [Benchmark]

677o_1_space_filtering size =

678 [ bgroup

679 "filtering"

680 [ benchIO "takeWhileM" $ takeWhileM size

681 , benchIO "takeWhile" $ takeWhile size

682 , benchIO "take" $ take size

683 , benchIO "filter" $ filter size

684 , benchIO "filterM" $ filterM size

685 -- Very small benchmark, reporting in ns

686 -- , benchIO "dropOne" $ dropOne size

687 , benchIO "dropAll" $ dropAll size

688 , benchIO "dropWhileTrue" $ dropWhileTrue size

689 , benchIO "dropWhileFalse" $ dropWhileFalse size

690 , benchIO "dropWhileMTrue" $ dropWhileMTrue size

691 , benchIO "dropWhileMFalse" $ dropWhileMFalse size

692 ]

693 ]

694

695o_1_space_zip :: Int -> [Benchmark]

696o_1_space_zip size =

697 [ bgroup

698 "zip"

699 [ benchIO "zipWithM" $ zipWithM size

700 , benchIO "zipWith" $ zipWith size

701 , benchIO "teeZipWith" $ teeZipWith size

702 ]

703 ]

704

705lf :: Word8

706lf = fromIntegral (ord '\n')

707

708-- | Split on line feed.

709foldManySepBy :: Handle -> IO Int

710foldManySepBy =

711 let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.reader

712 in UF.fold FL.length u

713

714o_1_space_nested :: BenchEnv -> Int -> [Benchmark]

715o_1_space_nested env size =

716 [ bgroup

717 "nested"

718 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size

719 -- Unimplemented

720 -- , benchIO "apDiscardFst" $ apDiscardFst size

721 -- , benchIO "apDiscardSnd" $ apDiscardSnd size

722

723 , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size

724 , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size

725 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size

726 , benchIO "breakAfterSome" $ breakAfterSome size

727 , benchIO "filterAllOut" $ filterAllOut size

728 , benchIO "filterAllIn" $ filterAllIn size

729 , benchIO "filterSome" $ filterSome size

730

731 , benchIO "many" $ many size

732 , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env

733 $ \inh _ -> foldManySepBy inh

734 ]

735 ]

736

737o_n_space_nested :: Int -> [Benchmark]

738o_n_space_nested size =

739 [ bgroup

740 "nested"

741 [ benchIO "toList" $ toList size

742 , benchIO "toListSome" $ toListSome size

743 ]

744 ]

745

746-------------------------------------------------------------------------------

747-- Unfold Exception Benchmarks

748-------------------------------------------------------------------------------

749-- | Send the file contents to /dev/null with exception handling

750readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()

751readWriteOnExceptionUnfold inh devNull =

752 let readEx = UF.onException (\_ -> hClose inh) FH.reader

753 in S.fold (FH.write devNull) $ S.unfold readEx inh

754

755#ifdef INSPECTION

756-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold

757-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step

758#endif

759

760-- | Send the file contents to /dev/null with exception handling

761readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()

762readWriteHandleExceptionUnfold inh devNull =

763 let handler (_e :: SomeException) = hClose inh >> return 10

764 readEx = UF.handle (UF.functionM handler) FH.reader

765 in S.fold (FH.write devNull) $ S.unfold readEx inh

766

767#ifdef INSPECTION

768-- hasNoTypeClasses started failing in GHC 9.4.4

769-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold

770-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step

771#endif

772

773-- | Send the file contents to /dev/null with exception handling

774readWriteFinally_Unfold :: Handle -> Handle -> IO ()

775readWriteFinally_Unfold inh devNull =

776 let readEx = UF.finally_ (\_ -> hClose inh) FH.reader

777 in S.fold (FH.write devNull) $ S.unfold readEx inh

778

779#ifdef INSPECTION

780#if __GLASGOW_HASKELL__ >= 906

781inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]

782#else

783inspect $ hasNoTypeClasses 'readWriteFinally_Unfold

784#endif

785-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step

786#endif

787

788readWriteFinallyUnfold :: Handle -> Handle -> IO ()

789readWriteFinallyUnfold inh devNull =

790 let readEx = UF.finally (\_ -> hClose inh) FH.reader

791 in S.fold (FH.write devNull) $ S.unfold readEx inh

792

793-- | Send the file contents to /dev/null with exception handling

794readWriteBracket_Unfold :: Handle -> Handle -> IO ()

795readWriteBracket_Unfold inh devNull =

796 let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader

797 in S.fold (FH.write devNull) $ S.unfold readEx inh

798

799#ifdef INSPECTION

800#if __GLASGOW_HASKELL__ >= 906

801inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]

802#else

803inspect $ hasNoTypeClasses 'readWriteBracket_Unfold

804#endif

805-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step

806#endif

807

808readWriteBracketUnfold :: Handle -> Handle -> IO ()

809readWriteBracketUnfold inh devNull =

810 let readEx = UF.bracket return (\_ -> hClose inh) FH.reader

811 in S.fold (FH.write devNull) $ S.unfold readEx inh

812

813o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]

814o_1_space_copy_read_exceptions env =

815 [ bgroup "exceptions"

816 [ mkBenchSmall "UF.onException" env $ \inh _ ->

817 readWriteOnExceptionUnfold inh (nullH env)

818 , mkBenchSmall "UF.handle" env $ \inh _ ->

819 readWriteHandleExceptionUnfold inh (nullH env)

820 , mkBenchSmall "UF.finally_" env $ \inh _ ->

821 readWriteFinally_Unfold inh (nullH env)

822 , mkBenchSmall "UF.finally" env $ \inh _ ->

823 readWriteFinallyUnfold inh (nullH env)

824 , mkBenchSmall "UF.bracket_" env $ \inh _ ->

825 readWriteBracket_Unfold inh (nullH env)

826 , mkBenchSmall "UF.bracket" env $ \inh _ ->

827 readWriteBracketUnfold inh (nullH env)

828 ]

829 ]

830

831

832-------------------------------------------------------------------------------

833-- Driver

834-------------------------------------------------------------------------------

835

836main :: IO ()

837main = do

838 env <- mkHandleBenchEnv

839 runWithCLIOpts defaultStreamSize (allBenchmarks env)

840

841 where

842

843 allBenchmarks env size =

844 [ bgroup (o_1_space_prefix moduleName)

845 $ Prelude.concat

846 [ o_1_space_transformation_input size

847 , o_1_space_generation size

848 , o_1_space_transformation size

849 , o_1_space_filtering size

850 , o_1_space_zip size

851 , o_1_space_nested env size

852 , o_1_space_copy_read_exceptions env

853 ]

854 , bgroup (o_n_space_prefix moduleName)

855 $ Prelude.concat [o_n_space_nested size]

856 ]