git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/Streamly/Benchmark/Data/Unfold.hs
827 lines 27 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.supplySecond n UF.enumerateFromToIntegral
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.supplySecond to UF.enumerateFromToIntegral)
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.supplySecond to UF.enumerateFromToIntegral
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.enumerateFromThenIntegral)
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.enumerateFromThenIntegral)
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.enumerateFromThenIntegral)
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 enumerateFromThenIntegral #-}
249enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()
250enumerateFromThenIntegral size start =
251 drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)
253{-# INLINE enumerateFromToIntegral #-}
254enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
255enumerateFromToIntegral size start =
256 drainGeneration
257 ( UF.supplySecond
258 (size + start)
259 UF.enumerateFromToIntegral
260 ) start
262{-# INLINE enumerateFromIntegral #-}
263enumerateFromIntegral :: Monad m => Int -> Int -> m ()
264enumerateFromIntegral size start =
265 drainGeneration (UF.take size UF.enumerateFromIntegral) start
267{-# INLINE enumerateFromStepNum #-}
268enumerateFromStepNum :: Monad m => Int -> Int -> m ()
269enumerateFromStepNum size start =
270 drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)
272{-# INLINE enumerateFromNum #-}
273enumerateFromNum :: Monad m => Int -> Int -> m ()
274enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start
276{-# INLINE enumerateFromToFractional #-}
277enumerateFromToFractional :: Monad m => Int -> Int -> m ()
278enumerateFromToFractional size start =
279 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
280 in drainGeneration
281 ( UF.supplySecond
282 (intToDouble $ start + size)
283 UF.enumerateFromToFractional
284 )
285 (intToDouble start)
287-------------------------------------------------------------------------------
288-- Stream transformation
289-------------------------------------------------------------------------------
291{-# INLINE map #-}
292map :: Monad m => Int -> Int -> m ()
293map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
295{-# INLINE mapM #-}
296mapM :: Monad m => Int -> Int -> m ()
297mapM size start =
298 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
300{-# INLINE mapMWithInput #-}
301mapMWithInput :: Monad m => Int -> Int -> m ()
302mapMWithInput size start =
303 drainTransformationDefault
304 size
305 (UF.mapMWithInput (\a b -> return $ a + b))
306 start
308-------------------------------------------------------------------------------
309-- Stream filtering
310-------------------------------------------------------------------------------
312{-# INLINE takeWhileM #-}
313takeWhileM :: Monad m => Int -> Int -> m ()
314takeWhileM size start =
315 drainTransformationDefault
316 size
317 (UF.takeWhileM (\b -> return (b <= size + start)))
318 start
320{-# INLINE takeWhile #-}
321takeWhile :: Monad m => Int -> Int -> m ()
322takeWhile size start =
323 drainTransformationDefault
324 size
325 (UF.takeWhile (\b -> b <= size + start))
326 start
328{-# INLINE take #-}
329take :: Monad m => Int -> Int -> m ()
330take size start = drainTransformationDefault (size + start) (UF.take size) start
332{-# INLINE filter #-}
333filter :: Monad m => Int -> Int -> m ()
334filter size start =
335 drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start
337{-# INLINE filterM #-}
338filterM :: Monad m => Int -> Int -> m ()
339filterM size start =
340 drainTransformationDefault
341 (size + start)
342 (UF.filterM (\_ -> (return True)))
343 start
345{-# INLINE _dropOne #-}
346_dropOne :: Monad m => Int -> Int -> m ()
347_dropOne size start =
348 drainTransformationDefault (size + start) (UF.drop 1) start
350{-# INLINE dropAll #-}
351dropAll :: Monad m => Int -> Int -> m ()
352dropAll size start =
353 drainTransformationDefault (size + start) (UF.drop (size + 1)) start
355{-# INLINE dropWhileTrue #-}
356dropWhileTrue :: Monad m => Int -> Int -> m ()
357dropWhileTrue size start =
358 drainTransformationDefault
359 (size + start)
360 (UF.dropWhileM (\_ -> return True))
361 start
363{-# INLINE dropWhileFalse #-}
364dropWhileFalse :: Monad m => Int -> Int -> m ()
365dropWhileFalse size start =
366 drainTransformationDefault
367 (size + start)
368 (UF.dropWhileM (\_ -> return False))
369 start
371{-# INLINE dropWhileMTrue #-}
372dropWhileMTrue :: Monad m => Int -> Int -> m ()
373dropWhileMTrue size start =
374 drainTransformationDefault
375 size
376 (UF.dropWhileM (\_ -> return True))
377 start
379{-# INLINE dropWhileMFalse #-}
380dropWhileMFalse :: Monad m => Int -> Int -> m ()
381dropWhileMFalse size start =
382 drainTransformationDefault
383 size
384 (UF.dropWhileM (\_ -> return False))
385 start
387-------------------------------------------------------------------------------
388-- Stream combination
389-------------------------------------------------------------------------------
391{-# INLINE zipWith #-}
392zipWith :: Monad m => Int -> Int -> m ()
393zipWith size start =
394 drainProductDefault (size + start) (UF.zipWith (+)) start
396{-# INLINE zipWithM #-}
397zipWithM :: Monad m => Int -> Int -> m ()
398zipWithM size start =
399 drainProductDefault
400 (size + start)
401 (UF.zipWithM (\a b -> return $ a + b))
402 start
404{-# INLINE teeZipWith #-}
405teeZipWith :: Monad m => Int -> Int -> m ()
406teeZipWith size start =
407 drainProductDefault (size + start) (UF.zipWith (+)) start
409-------------------------------------------------------------------------------
410-- Applicative
411-------------------------------------------------------------------------------
413{-# INLINE toNullAp #-}
414toNullAp :: Monad m => Int -> Int -> m ()
415toNullAp value start =
416 let end = start + nthRoot 2 value
417 s = source end
418 -- in UF.fold ((+) <$> s <*> s) FL.drain start
419 in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
421{-# INLINE _apDiscardFst #-}
422_apDiscardFst :: Int -> Int -> m ()
423_apDiscardFst = undefined
425{-# INLINE _apDiscardSnd #-}
426_apDiscardSnd :: Int -> Int -> m ()
427_apDiscardSnd = undefined
429-------------------------------------------------------------------------------
430-- Monad
431-------------------------------------------------------------------------------
433nthRoot :: Double -> Int -> Int
434nthRoot n value = round (fromIntegral value**(1/n))
436{-# INLINE concatMapM #-}
437concatMapM :: Monad m => Int -> Int -> m ()
438concatMapM value start =
439 val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
441 where
443 val = nthRoot 2 value
444 unfoldInGen i = return (UF.supplySecond (i + val) UF.enumerateFromToIntegral)
445 unfoldOut = UF.supplySecond (start + val) UF.enumerateFromToIntegral
447{-# INLINE toNull #-}
448toNull :: Monad m => Int -> Int -> m ()
449toNull value start =
450 let end = start + nthRoot 2 value
451 src = source end
452 {-
453 u = do
454 x <- src
455 y <- src
456 return (x + y)
457 -}
458 u = src `UF.bind` \x ->
459 src `UF.bind` \y ->
460 UF.fromPure (x + y)
461 in UF.fold FL.drain u start
464{-# INLINE toNull3 #-}
465toNull3 :: Monad m => Int -> Int -> m ()
466toNull3 value start =
467 let end = start + nthRoot 3 value
468 src = source end
469 {-
470 u = do
471 x <- src
472 y <- src
473 z <- src
474 return (x + y + z)
475 -}
476 u = src `UF.bind` \x ->
477 src `UF.bind` \y ->
478 UF.fromPure (x + y)
479 in UF.fold FL.drain u start
481{-# INLINE toList #-}
482toList :: Monad m => Int -> Int -> m [Int]
483toList value start = do
484 let end = start + nthRoot 2 value
485 src = source end
486 {-
487 u = do
488 x <- src
489 y <- src
490 return (x + y)
491 -}
492 u = src `UF.bind` \x ->
493 src `UF.bind` \y ->
494 UF.fromPure (x + y)
495 in UF.fold FL.toList u start
497{-# INLINE toListSome #-}
498toListSome :: Monad m => Int -> Int -> m [Int]
499toListSome value start = do
500 let end = start + nthRoot 2 value
501 src = source end
502 {-
503 u = do
504 x <- src
505 y <- src
506 return (x + y)
507 -}
508 u = src `UF.bind` \x ->
509 src `UF.bind` \y ->
510 UF.fromPure (x + y)
511 in UF.fold FL.toList (UF.take 1000 u) start
513{-# INLINE filterAllOut #-}
514filterAllOut :: Monad m => Int -> Int -> m ()
515filterAllOut value start = do
516 let end = start + nthRoot 2 value
517 src = source end
518 {-
519 u = do
520 x <- src
521 y <- src
522 -}
523 u = src `UF.bind` \x ->
524 src `UF.bind` \y ->
525 let s = x + y
526 in if s < 0
527 then UF.fromPure s
528 else UF.nilM (return . const ())
529 in UF.fold FL.drain u start
531{-# INLINE filterAllIn #-}
532filterAllIn :: Monad m => Int -> Int -> m ()
533filterAllIn value start = do
534 let end = start + nthRoot 2 value
535 src = source end
536 {-
537 u = do
538 x <- src
539 y <- src
540 -}
541 u = src `UF.bind` \x ->
542 src `UF.bind` \y ->
543 let s = x + y
544 in if s > 0
545 then UF.fromPure s
546 else UF.nilM (return . const ())
547 in UF.fold FL.drain u start
549{-# INLINE filterSome #-}
550filterSome :: Monad m => Int -> Int -> m ()
551filterSome value start = do
552 let end = start + nthRoot 2 value
553 src = source end
554 {-
555 u = do
556 x <- src
557 y <- src
558 -}
559 u = src `UF.bind` \x ->
560 src `UF.bind` \y ->
561 let s = x + y
562 in if s > 1100000
563 then UF.fromPure s
564 else UF.nilM (return . const ())
565 in UF.fold FL.drain u start
567{-# INLINE breakAfterSome #-}
568breakAfterSome :: Int -> Int -> IO ()
569breakAfterSome value start =
570 let end = start + nthRoot 2 value
571 src = source end
572 {-
573 u = do
574 x <- src
575 y <- src
576 -}
577 u = src `UF.bind` \x ->
578 src `UF.bind` \y ->
579 let s = x + y
580 in if s > 1100000
581 then error "break"
582 else UF.fromPure s
583 in do
584 (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start
585 return ()
587-------------------------------------------------------------------------------
588-- Benchmark ops
589-------------------------------------------------------------------------------
591-- n * (n + 1) / 2 == linearCount
592concatCount :: Int -> Int
593concatCount linearCount =
594 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
596{-# INLINE concat #-}
597concat :: Monad m => Int -> Int -> m ()
598concat linearCount start = do
599 let end = start + concatCount linearCount
600 UF.fold FL.drain (UF.many (source end) (source end)) start
602-------------------------------------------------------------------------------
603-- Benchmarks
604-------------------------------------------------------------------------------
606moduleName :: String
607moduleName = "Data.Unfold"
609o_1_space_transformation_input :: Int -> [Benchmark]
610o_1_space_transformation_input size =
611 [ bgroup
612 "transformation/input"
613 [ benchIO "lmap" $ lmap size
614 , benchIO "lmapM" $ lmapM size
615 , benchIO "supply" $ supply size
616 , benchIO "supplyFirst" $ supplyFirst size
617 , benchIO "supplySecond" $ supplySecond size
618 , benchIO "discardFirst" $ discardFirst size
619 , benchIO "discardSecond" $ discardSecond size
620 , benchIO "swap" $ swap size
621 ]
622 ]
624o_1_space_generation :: Int -> [Benchmark]
625o_1_space_generation size =
626 [ bgroup
627 "generation"
628 [ benchIO "fromStream" $ fromStream size
629 , benchIO "fromStreamK" $ fromStreamK size
630 , benchIO "fromStreamD" $ fromStreamD size
631 -- Very small benchmarks, reporting in ns
632 -- , benchIO "nilM" $ nilM size
633 , benchIO "consM" $ consM size
634 -- , benchIO "functionM" $ functionM size
635 -- , benchIO "function" $ function size
636 -- , benchIO "identity" $ identity size
637 -- , benchIO "const" $ const size
638 , benchIO "unfoldrM" $ unfoldrM size
639 , benchIO "fromList" $ fromList size
640 , benchIO "fromListM" $ fromListM size
641 -- Unimplemented
642 -- , benchIO "fromSVar" $ fromSVar size
643 -- , benchIO "fromProducer" $ fromProducer size
644 , benchIO "replicateM" $ replicateM size
645 , benchIO "repeatM" $ repeatM size
646 , benchIO "iterateM" $ iterateM size
647 , benchIO "fromIndicesM" $ fromIndicesM size
648 , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size
649 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
650 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
651 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
652 , benchIO "enumerateFromNum" $ enumerateFromNum size
653 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
654 ]
655 ]
657o_1_space_transformation :: Int -> [Benchmark]
658o_1_space_transformation size =
659 [ bgroup
660 "transformation"
661 [ benchIO "map" $ map size
662 , benchIO "mapM" $ mapM size
663 , benchIO "mapMWithInput" $ mapMWithInput size
664 ]
665 ]
667o_1_space_filtering :: Int -> [Benchmark]
668o_1_space_filtering size =
669 [ bgroup
670 "filtering"
671 [ benchIO "takeWhileM" $ takeWhileM size
672 , benchIO "takeWhile" $ takeWhile size
673 , benchIO "take" $ take size
674 , benchIO "filter" $ filter size
675 , benchIO "filterM" $ filterM size
676 -- Very small benchmark, reporting in ns
677 -- , benchIO "dropOne" $ dropOne size
678 , benchIO "dropAll" $ dropAll size
679 , benchIO "dropWhileTrue" $ dropWhileTrue size
680 , benchIO "dropWhileFalse" $ dropWhileFalse size
681 , benchIO "dropWhileMTrue" $ dropWhileMTrue size
682 , benchIO "dropWhileMFalse" $ dropWhileMFalse size
683 ]
684 ]
686o_1_space_zip :: Int -> [Benchmark]
687o_1_space_zip size =
688 [ bgroup
689 "zip"
690 [ benchIO "zipWithM" $ zipWithM size
691 , benchIO "zipWith" $ zipWith size
692 , benchIO "teeZipWith" $ teeZipWith size
693 ]
694 ]
696o_1_space_nested :: Int -> [Benchmark]
697o_1_space_nested size =
698 [ bgroup
699 "nested"
700 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
701 -- Unimplemented
702 -- , benchIO "apDiscardFst" $ apDiscardFst size
703 -- , benchIO "apDiscardSnd" $ apDiscardSnd size
705 , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size
706 , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size
707 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size
708 , benchIO "breakAfterSome" $ breakAfterSome size
709 , benchIO "filterAllOut" $ filterAllOut size
710 , benchIO "filterAllIn" $ filterAllIn size
711 , benchIO "filterSome" $ filterSome size
713 , benchIO "concat" $ concat size
714 ]
715 ]
717o_n_space_nested :: Int -> [Benchmark]
718o_n_space_nested size =
719 [ bgroup
720 "nested"
721 [ benchIO "toList" $ toList size
722 , benchIO "toListSome" $ toListSome size
723 ]
724 ]
726-------------------------------------------------------------------------------
727-- Unfold Exception Benchmarks
728-------------------------------------------------------------------------------
729-- | Send the file contents to /dev/null with exception handling
730readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
731readWriteOnExceptionUnfold inh devNull =
732 let readEx = UF.onException (\_ -> hClose inh) FH.read
733 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
735#ifdef INSPECTION
736inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
737-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
738#endif
740-- | Send the file contents to /dev/null with exception handling
741readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
742readWriteHandleExceptionUnfold inh devNull =
743 let handler (_e :: SomeException) = hClose inh >> return 10
744 readEx = UF.handle (UF.functionM handler) FH.read
745 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
747#ifdef INSPECTION
748inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
749-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
750#endif
752-- | Send the file contents to /dev/null with exception handling
753readWriteFinally_Unfold :: Handle -> Handle -> IO ()
754readWriteFinally_Unfold inh devNull =
755 let readEx = UF.finally_ (\_ -> hClose inh) FH.read
756 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
758#ifdef INSPECTION
759inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
760-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
761#endif
763readWriteFinallyUnfold :: Handle -> Handle -> IO ()
764readWriteFinallyUnfold inh devNull =
765 let readEx = UF.finally (\_ -> hClose inh) FH.read
766 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
768-- | Send the file contents to /dev/null with exception handling
769readWriteBracket_Unfold :: Handle -> Handle -> IO ()
770readWriteBracket_Unfold inh devNull =
771 let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
772 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
774#ifdef INSPECTION
775inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
776-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
777#endif
779readWriteBracketUnfold :: Handle -> Handle -> IO ()
780readWriteBracketUnfold inh devNull =
781 let readEx = UF.bracket return (\_ -> hClose inh) FH.read
782 in SP.fold (FH.write devNull) $ S.unfold readEx inh
784o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
785o_1_space_copy_read_exceptions env =
786 [ bgroup "exceptions"
787 [ mkBenchSmall "UF.onException" env $ \inh _ ->
788 readWriteOnExceptionUnfold inh (nullH env)
789 , mkBenchSmall "UF.handle" env $ \inh _ ->
790 readWriteHandleExceptionUnfold inh (nullH env)
791 , mkBenchSmall "UF.finally_" env $ \inh _ ->
792 readWriteFinally_Unfold inh (nullH env)
793 , mkBenchSmall "UF.finally" env $ \inh _ ->
794 readWriteFinallyUnfold inh (nullH env)
795 , mkBenchSmall "UF.bracket_" env $ \inh _ ->
796 readWriteBracket_Unfold inh (nullH env)
797 , mkBenchSmall "UF.bracket" env $ \inh _ ->
798 readWriteBracketUnfold inh (nullH env)
799 ]
800 ]
803-------------------------------------------------------------------------------
804-- Driver
805-------------------------------------------------------------------------------
807main :: IO ()
808main = do
809 env <- mkHandleBenchEnv
810 runWithCLIOpts defaultStreamSize (allBenchmarks env)
812 where
814 allBenchmarks env size =
815 [ bgroup (o_1_space_prefix moduleName)
816 $ Prelude.concat
817 [ o_1_space_transformation_input size
818 , o_1_space_generation size
819 , o_1_space_transformation size
820 , o_1_space_filtering size
821 , o_1_space_zip size
822 , o_1_space_nested size
823 , o_1_space_copy_read_exceptions env
824 ]
825 , bgroup (o_n_space_prefix moduleName)
826 $ Prelude.concat [o_n_space_nested size]
827 ]