git.iko.soy/streamly
on 3feeec2 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Unfold.hs
820 lines 26 kB history raw
1-- |
2-- Module : Streamly.Benchmark.Data.Fold
3-- Copyright : (c) 2018 Composewell
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 Streamly.Internal.Data.Unfold (Unfold)
25import System.IO (Handle, hClose)
26import System.Random (randomRIO)
28import qualified Prelude
29import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Fold as FL
31import qualified Streamly.Internal.Data.Unfold as UF
32import qualified Streamly.Internal.Data.Stream.IsStream as S
33import qualified Streamly.Internal.Data.Stream.StreamD as D
34import qualified Streamly.Internal.Data.Stream.StreamK as K
35import qualified Streamly.Prelude as SP
37import Gauge hiding (env)
38import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
39import Streamly.Benchmark.Common
40import Streamly.Benchmark.Common.Handle
42#ifdef INSPECTION
43import Test.Inspection
44#endif
46{-# INLINE benchIO #-}
47benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
48benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
50-------------------------------------------------------------------------------
51-- Stream generation and elimination
52-------------------------------------------------------------------------------
54-- generate numbers up to the argument value
55{-# INLINE source #-}
56source :: Monad m => Int -> Unfold m Int Int
57source n = UF.enumerateFromToIntegral n
59-------------------------------------------------------------------------------
60-- Benchmark helpers
61-------------------------------------------------------------------------------
63{-# INLINE drainGeneration #-}
64drainGeneration :: Monad m => Unfold m a b -> a -> m ()
65drainGeneration unf seed = UF.fold FL.drain unf seed
67{-# INLINE drainTransformation #-}
68drainTransformation ::
69 Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()
70drainTransformation unf f seed = drainGeneration (f unf) seed
72{-# INLINE drainTransformationDefault #-}
73drainTransformationDefault ::
74 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
75drainTransformationDefault to =
76 drainTransformation (UF.enumerateFromToIntegral to)
78{-# INLINE drainProduct #-}
79drainProduct ::
80 Monad m
81 => Unfold m a b
82 -> Unfold m c d
83 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
84 -> e
85 -> m ()
86drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed
88{-# INLINE drainProductDefault #-}
89drainProductDefault ::
90 Monad m
91 => Int
92 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
93 -> e
94 -> m ()
95drainProductDefault to = drainProduct src src
97 where
99 src = UF.enumerateFromToIntegral to
101-------------------------------------------------------------------------------
102-- Operations on input
103-------------------------------------------------------------------------------
105{-# INLINE lmap #-}
106lmap :: Monad m => Int -> Int -> m ()
107lmap size start =
108 drainTransformationDefault (size + start) (UF.lmap (+ 1)) start
110{-# INLINE lmapM #-}
111lmapM :: Monad m => Int -> Int -> m ()
112lmapM size start =
113 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
115{-# INLINE supply #-}
116supply :: Monad m => Int -> Int -> m ()
117supply size start =
118 drainTransformationDefault (size + start) (UF.supply start) undefined
121{-# INLINE supplyFirst #-}
122supplyFirst :: Monad m => Int -> Int -> m ()
123supplyFirst size start =
124 drainTransformation
125 (UF.take size UF.enumerateFromStepIntegral)
126 (UF.supplyFirst start)
127 1
129{-# INLINE supplySecond #-}
130supplySecond :: Monad m => Int -> Int -> m ()
131supplySecond size start =
132 drainTransformation
133 (UF.take size UF.enumerateFromStepIntegral)
134 (UF.supplySecond 1)
135 start
137{-# INLINE discardFirst #-}
138discardFirst :: Monad m => Int -> Int -> m ()
139discardFirst size start =
140 drainTransformationDefault (size + start) UF.discardFirst (start, start)
142{-# INLINE discardSecond #-}
143discardSecond :: Monad m => Int -> Int -> m ()
144discardSecond size start =
145 drainTransformationDefault (size + start) UF.discardSecond (start, start)
147{-# INLINE swap #-}
148swap :: Monad m => Int -> Int -> m ()
149swap size start =
150 drainTransformation
151 (UF.take size UF.enumerateFromStepIntegral)
152 UF.swap
153 (1, start)
155-------------------------------------------------------------------------------
156-- Stream generation
157-------------------------------------------------------------------------------
159{-# INLINE fromStream #-}
160fromStream :: Int -> Int -> IO ()
161fromStream size start =
162 drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
164-- XXX INVESTIGATE: Although the performance of this should be equivalant to
165-- fromStream, this is considerably worse. More than 4x worse.
166{-# INLINE fromStreamK #-}
167fromStreamK :: Monad m => Int -> Int -> m ()
168fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)
170{-# INLINE fromStreamD #-}
171fromStreamD :: Monad m => Int -> Int -> m ()
172fromStreamD size start =
173 drainGeneration UF.fromStreamD (D.replicate size start)
175{-# INLINE _nilM #-}
176_nilM :: Monad m => Int -> Int -> m ()
177_nilM _ start = drainGeneration (UF.nilM return) start
179{-# INLINE consM #-}
180consM :: Monad m => Int -> Int -> m ()
181consM size start =
182 drainTransformationDefault (size + start) (UF.consM return) start
184{-# INLINE _functionM #-}
185_functionM :: Monad m => Int -> Int -> m ()
186_functionM _ start = drainGeneration (UF.functionM return) start
188{-# INLINE _function #-}
189_function :: Monad m => Int -> Int -> m ()
190_function _ start = drainGeneration (UF.function id) start
192{-# INLINE _identity #-}
193_identity :: Monad m => Int -> Int -> m ()
194_identity _ start = drainGeneration UF.identity start
196{-# INLINE _const #-}
197_const :: Monad m => Int -> Int -> m ()
198_const size start =
199 drainGeneration (UF.take size (UF.fromEffect (return start))) undefined
201{-# INLINE unfoldrM #-}
202unfoldrM :: Monad m => Int -> Int -> m ()
203unfoldrM size start = drainGeneration (UF.unfoldrM step) start
205 where
207 step i =
208 return
209 $ if i < start + size
210 then Just (i, i + 1)
211 else Nothing
213{-# INLINE fromList #-}
214fromList :: Monad m => Int -> Int -> m ()
215fromList size start = drainGeneration UF.fromList [start .. start + size]
217{-# INLINE fromListM #-}
218fromListM :: Monad m => Int -> Int -> m ()
219fromListM size start =
220 drainGeneration UF.fromListM (Prelude.map return [start .. start + size])
222{-# INLINE _fromSVar #-}
223_fromSVar :: Int -> Int -> m ()
224_fromSVar = undefined
226{-# INLINE _fromProducer #-}
227_fromProducer :: Int -> Int -> m ()
228_fromProducer = undefined
230{-# INLINE replicateM #-}
231replicateM :: Monad m => Int -> Int -> m ()
232replicateM size start = drainGeneration (UF.replicateM size) (return start)
234{-# INLINE repeatM #-}
235repeatM :: Monad m => Int -> Int -> m ()
236repeatM size start = drainGeneration (UF.take size UF.repeatM) (return start)
238{-# INLINE iterateM #-}
239iterateM :: Monad m => Int -> Int -> m ()
240iterateM size start =
241 drainGeneration (UF.take size (UF.iterateM return)) (return start)
243{-# INLINE fromIndicesM #-}
244fromIndicesM :: Monad m => Int -> Int -> m ()
245fromIndicesM size start =
246 drainGeneration (UF.take size (UF.fromIndicesM return)) start
248{-# INLINE enumerateFromStepIntegral #-}
249enumerateFromStepIntegral :: Monad m => Int -> Int -> m ()
250enumerateFromStepIntegral size start =
251 drainGeneration (UF.take size UF.enumerateFromStepIntegral) (start, 1)
253{-# INLINE enumerateFromToIntegral #-}
254enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
255enumerateFromToIntegral size start =
256 drainGeneration (UF.enumerateFromToIntegral (size + start)) start
258{-# INLINE enumerateFromIntegral #-}
259enumerateFromIntegral :: Monad m => Int -> Int -> m ()
260enumerateFromIntegral size start =
261 drainGeneration (UF.take size UF.enumerateFromIntegral) start
263{-# INLINE enumerateFromStepNum #-}
264enumerateFromStepNum :: Monad m => Int -> Int -> m ()
265enumerateFromStepNum size start =
266 drainGeneration (UF.take size (UF.enumerateFromStepNum 1)) start
268{-# INLINE numFrom #-}
269numFrom :: Monad m => Int -> Int -> m ()
270numFrom size start = drainGeneration (UF.take size UF.numFrom) start
272{-# INLINE enumerateFromToFractional #-}
273enumerateFromToFractional :: Monad m => Int -> Int -> m ()
274enumerateFromToFractional size start =
275 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
276 in drainGeneration
277 (UF.enumerateFromToFractional (intToDouble $ start + size))
278 (intToDouble start)
280-------------------------------------------------------------------------------
281-- Stream transformation
282-------------------------------------------------------------------------------
284{-# INLINE map #-}
285map :: Monad m => Int -> Int -> m ()
286map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
288{-# INLINE mapM #-}
289mapM :: Monad m => Int -> Int -> m ()
290mapM size start =
291 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
293{-# INLINE mapMWithInput #-}
294mapMWithInput :: Monad m => Int -> Int -> m ()
295mapMWithInput size start =
296 drainTransformationDefault
297 size
298 (UF.mapMWithInput (\a b -> return $ a + b))
299 start
301-------------------------------------------------------------------------------
302-- Stream filtering
303-------------------------------------------------------------------------------
305{-# INLINE takeWhileM #-}
306takeWhileM :: Monad m => Int -> Int -> m ()
307takeWhileM size start =
308 drainTransformationDefault
309 size
310 (UF.takeWhileM (\b -> return (b <= size + start)))
311 start
313{-# INLINE takeWhile #-}
314takeWhile :: Monad m => Int -> Int -> m ()
315takeWhile size start =
316 drainTransformationDefault
317 size
318 (UF.takeWhile (\b -> b <= size + start))
319 start
321{-# INLINE take #-}
322take :: Monad m => Int -> Int -> m ()
323take size start = drainTransformationDefault (size + start) (UF.take size) start
325{-# INLINE filter #-}
326filter :: Monad m => Int -> Int -> m ()
327filter size start =
328 drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start
330{-# INLINE filterM #-}
331filterM :: Monad m => Int -> Int -> m ()
332filterM size start =
333 drainTransformationDefault
334 (size + start)
335 (UF.filterM (\_ -> (return True)))
336 start
338{-# INLINE _dropOne #-}
339_dropOne :: Monad m => Int -> Int -> m ()
340_dropOne size start =
341 drainTransformationDefault (size + start) (UF.drop 1) start
343{-# INLINE dropAll #-}
344dropAll :: Monad m => Int -> Int -> m ()
345dropAll size start =
346 drainTransformationDefault (size + start) (UF.drop (size + 1)) start
348{-# INLINE dropWhileTrue #-}
349dropWhileTrue :: Monad m => Int -> Int -> m ()
350dropWhileTrue size start =
351 drainTransformationDefault
352 (size + start)
353 (UF.dropWhileM (\_ -> return True))
354 start
356{-# INLINE dropWhileFalse #-}
357dropWhileFalse :: Monad m => Int -> Int -> m ()
358dropWhileFalse size start =
359 drainTransformationDefault
360 (size + start)
361 (UF.dropWhileM (\_ -> return False))
362 start
364{-# INLINE dropWhileMTrue #-}
365dropWhileMTrue :: Monad m => Int -> Int -> m ()
366dropWhileMTrue size start =
367 drainTransformationDefault
368 size
369 (UF.dropWhileM (\_ -> return True))
370 start
372{-# INLINE dropWhileMFalse #-}
373dropWhileMFalse :: Monad m => Int -> Int -> m ()
374dropWhileMFalse size start =
375 drainTransformationDefault
376 size
377 (UF.dropWhileM (\_ -> return False))
378 start
380-------------------------------------------------------------------------------
381-- Stream combination
382-------------------------------------------------------------------------------
384{-# INLINE zipWith #-}
385zipWith :: Monad m => Int -> Int -> m ()
386zipWith size start =
387 drainProductDefault (size + start) (UF.zipWith (+)) start
389{-# INLINE zipWithM #-}
390zipWithM :: Monad m => Int -> Int -> m ()
391zipWithM size start =
392 drainProductDefault
393 (size + start)
394 (UF.zipWithM (\a b -> return $ a + b))
395 start
397{-# INLINE teeZipWith #-}
398teeZipWith :: Monad m => Int -> Int -> m ()
399teeZipWith size start =
400 drainProductDefault (size + start) (UF.zipWith (+)) start
402-------------------------------------------------------------------------------
403-- Applicative
404-------------------------------------------------------------------------------
406{-# INLINE toNullAp #-}
407toNullAp :: Monad m => Int -> Int -> m ()
408toNullAp value start =
409 let end = start + nthRoot 2 value
410 s = source end
411 -- in UF.fold ((+) <$> s <*> s) FL.drain start
412 in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
414{-# INLINE _apDiscardFst #-}
415_apDiscardFst :: Int -> Int -> m ()
416_apDiscardFst = undefined
418{-# INLINE _apDiscardSnd #-}
419_apDiscardSnd :: Int -> Int -> m ()
420_apDiscardSnd = undefined
422-------------------------------------------------------------------------------
423-- Monad
424-------------------------------------------------------------------------------
426nthRoot :: Double -> Int -> Int
427nthRoot n value = round (fromIntegral value**(1/n))
429{-# INLINE concatMapM #-}
430concatMapM :: Monad m => Int -> Int -> m ()
431concatMapM value start =
432 val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
434 where
436 val = nthRoot 2 value
437 unfoldInGen i = return (UF.enumerateFromToIntegral (i + val))
438 unfoldOut = UF.enumerateFromToIntegral (start + val)
440{-# INLINE toNull #-}
441toNull :: Monad m => Int -> Int -> m ()
442toNull value start =
443 let end = start + nthRoot 2 value
444 src = source end
445 {-
446 u = do
447 x <- src
448 y <- src
449 return (x + y)
450 -}
451 u = src `UF.bind` \x ->
452 src `UF.bind` \y ->
453 UF.fromPure (x + y)
454 in UF.fold FL.drain u start
457{-# INLINE toNull3 #-}
458toNull3 :: Monad m => Int -> Int -> m ()
459toNull3 value start =
460 let end = start + nthRoot 3 value
461 src = source end
462 {-
463 u = do
464 x <- src
465 y <- src
466 z <- src
467 return (x + y + z)
468 -}
469 u = src `UF.bind` \x ->
470 src `UF.bind` \y ->
471 UF.fromPure (x + y)
472 in UF.fold FL.drain u start
474{-# INLINE toList #-}
475toList :: Monad m => Int -> Int -> m [Int]
476toList value start = do
477 let end = start + nthRoot 2 value
478 src = source end
479 {-
480 u = do
481 x <- src
482 y <- src
483 return (x + y)
484 -}
485 u = src `UF.bind` \x ->
486 src `UF.bind` \y ->
487 UF.fromPure (x + y)
488 in UF.fold FL.toList u start
490{-# INLINE toListSome #-}
491toListSome :: Monad m => Int -> Int -> m [Int]
492toListSome value start = do
493 let end = start + nthRoot 2 value
494 src = source end
495 {-
496 u = do
497 x <- src
498 y <- src
499 return (x + y)
500 -}
501 u = src `UF.bind` \x ->
502 src `UF.bind` \y ->
503 UF.fromPure (x + y)
504 in UF.fold FL.toList (UF.take 1000 u) start
506{-# INLINE filterAllOut #-}
507filterAllOut :: Monad m => Int -> Int -> m ()
508filterAllOut value start = do
509 let end = start + nthRoot 2 value
510 src = source end
511 {-
512 u = do
513 x <- src
514 y <- src
515 -}
516 u = src `UF.bind` \x ->
517 src `UF.bind` \y ->
518 let s = x + y
519 in if s < 0
520 then UF.fromPure s
521 else UF.nilM (return . const ())
522 in UF.fold FL.drain u start
524{-# INLINE filterAllIn #-}
525filterAllIn :: Monad m => Int -> Int -> m ()
526filterAllIn value start = do
527 let end = start + nthRoot 2 value
528 src = source end
529 {-
530 u = do
531 x <- src
532 y <- src
533 -}
534 u = src `UF.bind` \x ->
535 src `UF.bind` \y ->
536 let s = x + y
537 in if s > 0
538 then UF.fromPure s
539 else UF.nilM (return . const ())
540 in UF.fold FL.drain u start
542{-# INLINE filterSome #-}
543filterSome :: Monad m => Int -> Int -> m ()
544filterSome value start = do
545 let end = start + nthRoot 2 value
546 src = source end
547 {-
548 u = do
549 x <- src
550 y <- src
551 -}
552 u = src `UF.bind` \x ->
553 src `UF.bind` \y ->
554 let s = x + y
555 in if s > 1100000
556 then UF.fromPure s
557 else UF.nilM (return . const ())
558 in UF.fold FL.drain u start
560{-# INLINE breakAfterSome #-}
561breakAfterSome :: Int -> Int -> IO ()
562breakAfterSome value start =
563 let end = start + nthRoot 2 value
564 src = source end
565 {-
566 u = do
567 x <- src
568 y <- src
569 -}
570 u = src `UF.bind` \x ->
571 src `UF.bind` \y ->
572 let s = x + y
573 in if s > 1100000
574 then error "break"
575 else UF.fromPure s
576 in do
577 (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start
578 return ()
580-------------------------------------------------------------------------------
581-- Benchmark ops
582-------------------------------------------------------------------------------
584-- n * (n + 1) / 2 == linearCount
585concatCount :: Int -> Int
586concatCount linearCount =
587 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
589{-# INLINE concat #-}
590concat :: Monad m => Int -> Int -> m ()
591concat linearCount start = do
592 let end = start + concatCount linearCount
593 UF.fold FL.drain (UF.many (source end) (source end)) start
595-------------------------------------------------------------------------------
596-- Benchmarks
597-------------------------------------------------------------------------------
599moduleName :: String
600moduleName = "Data.Unfold"
602o_1_space_transformation_input :: Int -> [Benchmark]
603o_1_space_transformation_input size =
604 [ bgroup
605 "transformation/input"
606 [ benchIO "lmap" $ lmap size
607 , benchIO "lmapM" $ lmapM size
608 , benchIO "supply" $ supply size
609 , benchIO "supplyFirst" $ supplyFirst size
610 , benchIO "supplySecond" $ supplySecond size
611 , benchIO "discardFirst" $ discardFirst size
612 , benchIO "discardSecond" $ discardSecond size
613 , benchIO "swap" $ swap size
614 ]
615 ]
617o_1_space_generation :: Int -> [Benchmark]
618o_1_space_generation size =
619 [ bgroup
620 "generation"
621 [ benchIO "fromStream" $ fromStream size
622 , benchIO "fromStreamK" $ fromStreamK size
623 , benchIO "fromStreamD" $ fromStreamD size
624 -- Very small benchmarks, reporting in ns
625 -- , benchIO "nilM" $ nilM size
626 , benchIO "consM" $ consM size
627 -- , benchIO "functionM" $ functionM size
628 -- , benchIO "function" $ function size
629 -- , benchIO "identity" $ identity size
630 -- , benchIO "const" $ const size
631 , benchIO "unfoldrM" $ unfoldrM size
632 , benchIO "fromList" $ fromList size
633 , benchIO "fromListM" $ fromListM size
634 -- Unimplemented
635 -- , benchIO "fromSVar" $ fromSVar size
636 -- , benchIO "fromProducer" $ fromProducer size
637 , benchIO "replicateM" $ replicateM size
638 , benchIO "repeatM" $ repeatM size
639 , benchIO "iterateM" $ iterateM size
640 , benchIO "fromIndicesM" $ fromIndicesM size
641 , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral size
642 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
643 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
644 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
645 , benchIO "numFrom" $ numFrom size
646 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
647 ]
648 ]
650o_1_space_transformation :: Int -> [Benchmark]
651o_1_space_transformation size =
652 [ bgroup
653 "transformation"
654 [ benchIO "map" $ map size
655 , benchIO "mapM" $ mapM size
656 , benchIO "mapMWithInput" $ mapMWithInput size
657 ]
658 ]
660o_1_space_filtering :: Int -> [Benchmark]
661o_1_space_filtering size =
662 [ bgroup
663 "filtering"
664 [ benchIO "takeWhileM" $ takeWhileM size
665 , benchIO "takeWhile" $ takeWhile size
666 , benchIO "take" $ take size
667 , benchIO "filter" $ filter size
668 , benchIO "filterM" $ filterM size
669 -- Very small benchmark, reporting in ns
670 -- , benchIO "dropOne" $ dropOne size
671 , benchIO "dropAll" $ dropAll size
672 , benchIO "dropWhileTrue" $ dropWhileTrue size
673 , benchIO "dropWhileFalse" $ dropWhileFalse size
674 , benchIO "dropWhileMTrue" $ dropWhileMTrue size
675 , benchIO "dropWhileMFalse" $ dropWhileMFalse size
676 ]
677 ]
679o_1_space_zip :: Int -> [Benchmark]
680o_1_space_zip size =
681 [ bgroup
682 "zip"
683 [ benchIO "zipWithM" $ zipWithM size
684 , benchIO "zipWith" $ zipWith size
685 , benchIO "teeZipWith" $ teeZipWith size
686 ]
687 ]
689o_1_space_nested :: Int -> [Benchmark]
690o_1_space_nested size =
691 [ bgroup
692 "nested"
693 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
694 -- Unimplemented
695 -- , benchIO "apDiscardFst" $ apDiscardFst size
696 -- , benchIO "apDiscardSnd" $ apDiscardSnd size
698 , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size
699 , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size
700 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size
701 , benchIO "breakAfterSome" $ breakAfterSome size
702 , benchIO "filterAllOut" $ filterAllOut size
703 , benchIO "filterAllIn" $ filterAllIn size
704 , benchIO "filterSome" $ filterSome size
706 , benchIO "concat" $ concat size
707 ]
708 ]
710o_n_space_nested :: Int -> [Benchmark]
711o_n_space_nested size =
712 [ bgroup
713 "nested"
714 [ benchIO "toList" $ toList size
715 , benchIO "toListSome" $ toListSome size
716 ]
717 ]
719-------------------------------------------------------------------------------
720-- Unfold Exception Benchmarks
721-------------------------------------------------------------------------------
722-- | Send the file contents to /dev/null with exception handling
723readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
724readWriteOnExceptionUnfold inh devNull =
725 let readEx = UF.onException (\_ -> hClose inh) FH.read
726 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
728#ifdef INSPECTION
729inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
730-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
731#endif
733-- | Send the file contents to /dev/null with exception handling
734readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
735readWriteHandleExceptionUnfold inh devNull =
736 let handler (_e :: SomeException) = hClose inh >> return 10
737 readEx = UF.handle (UF.functionM handler) FH.read
738 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
740#ifdef INSPECTION
741inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
742-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
743#endif
745-- | Send the file contents to /dev/null with exception handling
746readWriteFinally_Unfold :: Handle -> Handle -> IO ()
747readWriteFinally_Unfold inh devNull =
748 let readEx = UF.finally_ (\_ -> hClose inh) FH.read
749 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
751#ifdef INSPECTION
752inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
753-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
754#endif
756readWriteFinallyUnfold :: Handle -> Handle -> IO ()
757readWriteFinallyUnfold inh devNull =
758 let readEx = UF.finally (\_ -> hClose inh) FH.read
759 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
761-- | Send the file contents to /dev/null with exception handling
762readWriteBracket_Unfold :: Handle -> Handle -> IO ()
763readWriteBracket_Unfold inh devNull =
764 let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
765 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
767#ifdef INSPECTION
768inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
769-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
770#endif
772readWriteBracketUnfold :: Handle -> Handle -> IO ()
773readWriteBracketUnfold inh devNull =
774 let readEx = UF.bracket return (\_ -> hClose inh) FH.read
775 in SP.fold (FH.write devNull) $ S.unfold readEx inh
777o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
778o_1_space_copy_read_exceptions env =
779 [ bgroup "exceptions"
780 [ mkBenchSmall "UF.onException" env $ \inh _ ->
781 readWriteOnExceptionUnfold inh (nullH env)
782 , mkBenchSmall "UF.handle" env $ \inh _ ->
783 readWriteHandleExceptionUnfold inh (nullH env)
784 , mkBenchSmall "UF.finally_" env $ \inh _ ->
785 readWriteFinally_Unfold inh (nullH env)
786 , mkBenchSmall "UF.finally" env $ \inh _ ->
787 readWriteFinallyUnfold inh (nullH env)
788 , mkBenchSmall "UF.bracket_" env $ \inh _ ->
789 readWriteBracket_Unfold inh (nullH env)
790 , mkBenchSmall "UF.bracket" env $ \inh _ ->
791 readWriteBracketUnfold inh (nullH env)
792 ]
793 ]
796-------------------------------------------------------------------------------
797-- Driver
798-------------------------------------------------------------------------------
800main :: IO ()
801main = do
802 env <- mkHandleBenchEnv
803 runWithCLIOpts defaultStreamSize (allBenchmarks env)
805 where
807 allBenchmarks env size =
808 [ bgroup (o_1_space_prefix moduleName)
809 $ Prelude.concat
810 [ o_1_space_transformation_input size
811 , o_1_space_generation size
812 , o_1_space_transformation size
813 , o_1_space_filtering size
814 , o_1_space_zip size
815 , o_1_space_nested size
816 , o_1_space_copy_read_exceptions env
817 ]
818 , bgroup (o_n_space_prefix moduleName)
819 $ Prelude.concat [o_n_space_nested size]
820 ]