git.iko.soy/streamly
on 4e604ef help sign in
streamly/benchmark/Streamly/Benchmark/Data/Unfold.hs
846 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 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.Stream.IsStream as S
35import qualified Streamly.Internal.Data.Stream.StreamD as D
36import qualified Streamly.Internal.Data.Stream.StreamK as K
37import qualified Streamly.Prelude as SP
39import Gauge hiding (env)
40import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
41import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common.Handle
44#ifdef INSPECTION
45import Test.Inspection
46#endif
48{-# INLINE benchIO #-}
49benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
50benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
52-------------------------------------------------------------------------------
53-- Stream generation and elimination
54-------------------------------------------------------------------------------
56-- generate numbers up to the argument value
57{-# INLINE source #-}
58source :: Monad m => Int -> Unfold m Int Int
59source n = UF.second n UF.enumerateFromToIntegral
61-------------------------------------------------------------------------------
62-- Benchmark helpers
63-------------------------------------------------------------------------------
65{-# INLINE drainGeneration #-}
66drainGeneration :: Monad m => Unfold m a b -> a -> m ()
67drainGeneration unf seed = UF.fold FL.drain unf seed
69{-# INLINE drainTransformation #-}
70drainTransformation ::
71 Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()
72drainTransformation unf f seed = drainGeneration (f unf) seed
74{-# INLINE drainTransformationDefault #-}
75drainTransformationDefault ::
76 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
77drainTransformationDefault to =
78 drainTransformation (UF.second to UF.enumerateFromToIntegral)
80{-# INLINE drainProduct #-}
81drainProduct ::
82 Monad m
83 => Unfold m a b
84 -> Unfold m c d
85 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
86 -> e
87 -> m ()
88drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed
90{-# INLINE drainProductDefault #-}
91drainProductDefault ::
92 Monad m
93 => Int
94 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
95 -> e
96 -> m ()
97drainProductDefault to = drainProduct src src
99 where
101 src = UF.second to UF.enumerateFromToIntegral
103-------------------------------------------------------------------------------
104-- Operations on input
105-------------------------------------------------------------------------------
107{-# INLINE lmap #-}
108lmap :: Monad m => Int -> Int -> m ()
109lmap size start =
110 drainTransformationDefault (size + start) (UF.lmap (+ 1)) start
112{-# INLINE lmapM #-}
113lmapM :: Monad m => Int -> Int -> m ()
114lmapM size start =
115 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
117{-# INLINE both #-}
118both :: Monad m => Int -> Int -> m ()
119both size start =
120 drainTransformationDefault (size + start) (UF.both start) undefined
123{-# INLINE first #-}
124first :: Monad m => Int -> Int -> m ()
125first size start =
126 drainTransformation
127 (UF.take size UF.enumerateFromThenIntegral)
128 (UF.first start)
129 1
131{-# INLINE second #-}
132second :: Monad m => Int -> Int -> m ()
133second size start =
134 drainTransformation
135 (UF.take size UF.enumerateFromThenIntegral)
136 (UF.second 1)
137 start
139{-# INLINE discardFirst #-}
140discardFirst :: Monad m => Int -> Int -> m ()
141discardFirst size start =
142 drainTransformationDefault (size + start) UF.discardFirst (start, start)
144{-# INLINE discardSecond #-}
145discardSecond :: Monad m => Int -> Int -> m ()
146discardSecond size start =
147 drainTransformationDefault (size + start) UF.discardSecond (start, start)
149{-# INLINE swap #-}
150swap :: Monad m => Int -> Int -> m ()
151swap size start =
152 drainTransformation
153 (UF.take size UF.enumerateFromThenIntegral)
154 UF.swap
155 (1, start)
157-------------------------------------------------------------------------------
158-- Stream generation
159-------------------------------------------------------------------------------
161{-# INLINE fromStream #-}
162fromStream :: Int -> Int -> IO ()
163fromStream size start =
164 drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
166-- XXX INVESTIGATE: Although the performance of this should be equivalant to
167-- fromStream, this is considerably worse. More than 4x worse.
168{-# INLINE fromStreamK #-}
169fromStreamK :: Monad m => Int -> Int -> m ()
170fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)
172{-# INLINE fromStreamD #-}
173fromStreamD :: Monad m => Int -> Int -> m ()
174fromStreamD size start =
175 drainGeneration UF.fromStreamD (D.replicate size start)
177{-# INLINE _nilM #-}
178_nilM :: Monad m => Int -> Int -> m ()
179_nilM _ start = drainGeneration (UF.nilM return) start
181{-# INLINE consM #-}
182consM :: Monad m => Int -> Int -> m ()
183consM size start =
184 drainTransformationDefault (size + start) (UF.consM return) start
186{-# INLINE _functionM #-}
187_functionM :: Monad m => Int -> Int -> m ()
188_functionM _ start = drainGeneration (UF.functionM return) start
190{-# INLINE _function #-}
191_function :: Monad m => Int -> Int -> m ()
192_function _ start = drainGeneration (UF.function id) start
194{-# INLINE _identity #-}
195_identity :: Monad m => Int -> Int -> m ()
196_identity _ start = drainGeneration UF.identity start
198{-# INLINE _const #-}
199_const :: Monad m => Int -> Int -> m ()
200_const size start =
201 drainGeneration (UF.take size (UF.fromEffect (return start))) undefined
203{-# INLINE unfoldrM #-}
204unfoldrM :: Monad m => Int -> Int -> m ()
205unfoldrM size start = drainGeneration (UF.unfoldrM step) start
207 where
209 step i =
210 return
211 $ if i < start + size
212 then Just (i, i + 1)
213 else Nothing
215{-# INLINE fromList #-}
216fromList :: Monad m => Int -> Int -> m ()
217fromList size start = drainGeneration UF.fromList [start .. start + size]
219{-# INLINE fromListM #-}
220fromListM :: Monad m => Int -> Int -> m ()
221fromListM size start =
222 drainGeneration UF.fromListM (Prelude.map return [start .. start + size])
224{-# INLINE _fromSVar #-}
225_fromSVar :: Int -> Int -> m ()
226_fromSVar = undefined
228{-# INLINE _fromProducer #-}
229_fromProducer :: Int -> Int -> m ()
230_fromProducer = undefined
232{-# INLINE replicateM #-}
233replicateM :: Monad m => Int -> Int -> m ()
234replicateM size start = drainGeneration (UF.replicateM size) (return start)
236{-# INLINE repeatM #-}
237repeatM :: Monad m => Int -> Int -> m ()
238repeatM size start = drainGeneration (UF.take size UF.repeatM) (return start)
240{-# INLINE iterateM #-}
241iterateM :: Monad m => Int -> Int -> m ()
242iterateM size start =
243 drainGeneration (UF.take size (UF.iterateM return)) (return start)
245{-# INLINE fromIndicesM #-}
246fromIndicesM :: Monad m => Int -> Int -> m ()
247fromIndicesM size start =
248 drainGeneration (UF.take size (UF.fromIndicesM return)) start
250{-# INLINE enumerateFromThenIntegral #-}
251enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()
252enumerateFromThenIntegral size start =
253 drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)
255{-# INLINE enumerateFromToIntegral #-}
256enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
257enumerateFromToIntegral size start =
258 drainGeneration
259 ( UF.second
260 (size + start)
261 UF.enumerateFromToIntegral
262 ) start
264{-# INLINE enumerateFromIntegral #-}
265enumerateFromIntegral :: Monad m => Int -> Int -> m ()
266enumerateFromIntegral size start =
267 drainGeneration (UF.take size UF.enumerateFromIntegral) start
269{-# INLINE enumerateFromStepNum #-}
270enumerateFromStepNum :: Monad m => Int -> Int -> m ()
271enumerateFromStepNum size start =
272 drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)
274{-# INLINE enumerateFromNum #-}
275enumerateFromNum :: Monad m => Int -> Int -> m ()
276enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start
278{-# INLINE enumerateFromToFractional #-}
279enumerateFromToFractional :: Monad m => Int -> Int -> m ()
280enumerateFromToFractional size start =
281 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
282 in drainGeneration
283 ( UF.second
284 (intToDouble $ start + size)
285 UF.enumerateFromToFractional
286 )
287 (intToDouble start)
289-------------------------------------------------------------------------------
290-- Stream transformation
291-------------------------------------------------------------------------------
293{-# INLINE postscan #-}
294postscan :: Monad m => Int -> Int -> m ()
295postscan size start =
296 drainTransformationDefault (size + start) (UF.postscan FL.sum) start
298{-# INLINE map #-}
299map :: Monad m => Int -> Int -> m ()
300map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
302{-# INLINE mapM #-}
303mapM :: Monad m => Int -> Int -> m ()
304mapM size start =
305 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
307{-# INLINE mapMWithInput #-}
308mapMWithInput :: Monad m => Int -> Int -> m ()
309mapMWithInput size start =
310 drainTransformationDefault
311 size
312 (UF.mapMWithInput (\a b -> return $ a + b))
313 start
315-------------------------------------------------------------------------------
316-- Stream filtering
317-------------------------------------------------------------------------------
319{-# INLINE takeWhileM #-}
320takeWhileM :: Monad m => Int -> Int -> m ()
321takeWhileM size start =
322 drainTransformationDefault
323 size
324 (UF.takeWhileM (\b -> return (b <= size + start)))
325 start
327{-# INLINE takeWhile #-}
328takeWhile :: Monad m => Int -> Int -> m ()
329takeWhile size start =
330 drainTransformationDefault
331 size
332 (UF.takeWhile (\b -> b <= size + start))
333 start
335{-# INLINE take #-}
336take :: Monad m => Int -> Int -> m ()
337take size start = drainTransformationDefault (size + start) (UF.take size) start
339{-# INLINE filter #-}
340filter :: Monad m => Int -> Int -> m ()
341filter size start =
342 drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start
344{-# INLINE filterM #-}
345filterM :: Monad m => Int -> Int -> m ()
346filterM size start =
347 drainTransformationDefault
348 (size + start)
349 (UF.filterM (\_ -> (return True)))
350 start
352{-# INLINE _dropOne #-}
353_dropOne :: Monad m => Int -> Int -> m ()
354_dropOne size start =
355 drainTransformationDefault (size + start) (UF.drop 1) start
357{-# INLINE dropAll #-}
358dropAll :: Monad m => Int -> Int -> m ()
359dropAll size start =
360 drainTransformationDefault (size + start) (UF.drop (size + 1)) start
362{-# INLINE dropWhileTrue #-}
363dropWhileTrue :: Monad m => Int -> Int -> m ()
364dropWhileTrue size start =
365 drainTransformationDefault
366 (size + start)
367 (UF.dropWhileM (\_ -> return True))
368 start
370{-# INLINE dropWhileFalse #-}
371dropWhileFalse :: Monad m => Int -> Int -> m ()
372dropWhileFalse size start =
373 drainTransformationDefault
374 (size + start)
375 (UF.dropWhileM (\_ -> return False))
376 start
378{-# INLINE dropWhileMTrue #-}
379dropWhileMTrue :: Monad m => Int -> Int -> m ()
380dropWhileMTrue size start =
381 drainTransformationDefault
382 size
383 (UF.dropWhileM (\_ -> return True))
384 start
386{-# INLINE dropWhileMFalse #-}
387dropWhileMFalse :: Monad m => Int -> Int -> m ()
388dropWhileMFalse size start =
389 drainTransformationDefault
390 size
391 (UF.dropWhileM (\_ -> return False))
392 start
394-------------------------------------------------------------------------------
395-- Stream combination
396-------------------------------------------------------------------------------
398{-# INLINE zipWith #-}
399zipWith :: Monad m => Int -> Int -> m ()
400zipWith size start =
401 drainProductDefault (size + start) (UF.zipWith (+)) start
403{-# INLINE zipWithM #-}
404zipWithM :: Monad m => Int -> Int -> m ()
405zipWithM size start =
406 drainProductDefault
407 (size + start)
408 (UF.zipWithM (\a b -> return $ a + b))
409 start
411{-# INLINE teeZipWith #-}
412teeZipWith :: Monad m => Int -> Int -> m ()
413teeZipWith size start =
414 drainProductDefault (size + start) (UF.zipWith (+)) start
416-------------------------------------------------------------------------------
417-- Applicative
418-------------------------------------------------------------------------------
420{-# INLINE toNullAp #-}
421toNullAp :: Monad m => Int -> Int -> m ()
422toNullAp value start =
423 let end = start + nthRoot 2 value
424 s = source end
425 -- in UF.fold ((+) <$> s <*> s) FL.drain start
426 in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
428{-# INLINE _apDiscardFst #-}
429_apDiscardFst :: Int -> Int -> m ()
430_apDiscardFst = undefined
432{-# INLINE _apDiscardSnd #-}
433_apDiscardSnd :: Int -> Int -> m ()
434_apDiscardSnd = undefined
436-------------------------------------------------------------------------------
437-- Monad
438-------------------------------------------------------------------------------
440nthRoot :: Double -> Int -> Int
441nthRoot n value = round (fromIntegral value**(1/n))
443{-# INLINE concatMapM #-}
444concatMapM :: Monad m => Int -> Int -> m ()
445concatMapM value start =
446 val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
448 where
450 val = nthRoot 2 value
451 unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
452 unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
454{-# INLINE toNull #-}
455toNull :: Monad m => Int -> Int -> m ()
456toNull value start =
457 let end = start + nthRoot 2 value
458 src = source end
459 {-
460 u = do
461 x <- src
462 y <- src
463 return (x + y)
464 -}
465 u = src `UF.bind` \x ->
466 src `UF.bind` \y ->
467 UF.fromPure (x + y)
468 in UF.fold FL.drain u start
471{-# INLINE toNull3 #-}
472toNull3 :: Monad m => Int -> Int -> m ()
473toNull3 value start =
474 let end = start + nthRoot 3 value
475 src = source end
476 {-
477 u = do
478 x <- src
479 y <- src
480 z <- src
481 return (x + y + z)
482 -}
483 u = src `UF.bind` \x ->
484 src `UF.bind` \y ->
485 UF.fromPure (x + y)
486 in UF.fold FL.drain u start
488{-# INLINE toList #-}
489toList :: Monad m => Int -> Int -> m [Int]
490toList value start = do
491 let end = start + nthRoot 2 value
492 src = source end
493 {-
494 u = do
495 x <- src
496 y <- src
497 return (x + y)
498 -}
499 u = src `UF.bind` \x ->
500 src `UF.bind` \y ->
501 UF.fromPure (x + y)
502 in UF.fold FL.toList u start
504{-# INLINE toListSome #-}
505toListSome :: Monad m => Int -> Int -> m [Int]
506toListSome value start = do
507 let end = start + nthRoot 2 value
508 src = source end
509 {-
510 u = do
511 x <- src
512 y <- src
513 return (x + y)
514 -}
515 u = src `UF.bind` \x ->
516 src `UF.bind` \y ->
517 UF.fromPure (x + y)
518 in UF.fold FL.toList (UF.take 1000 u) start
520{-# INLINE filterAllOut #-}
521filterAllOut :: Monad m => Int -> Int -> m ()
522filterAllOut value start = do
523 let end = start + nthRoot 2 value
524 src = source end
525 {-
526 u = do
527 x <- src
528 y <- src
529 -}
530 u = src `UF.bind` \x ->
531 src `UF.bind` \y ->
532 let s = x + y
533 in if s < 0
534 then UF.fromPure s
535 else UF.nilM (return . const ())
536 in UF.fold FL.drain u start
538{-# INLINE filterAllIn #-}
539filterAllIn :: Monad m => Int -> Int -> m ()
540filterAllIn value start = do
541 let end = start + nthRoot 2 value
542 src = source end
543 {-
544 u = do
545 x <- src
546 y <- src
547 -}
548 u = src `UF.bind` \x ->
549 src `UF.bind` \y ->
550 let s = x + y
551 in if s > 0
552 then UF.fromPure s
553 else UF.nilM (return . const ())
554 in UF.fold FL.drain u start
556{-# INLINE filterSome #-}
557filterSome :: Monad m => Int -> Int -> m ()
558filterSome value start = do
559 let end = start + nthRoot 2 value
560 src = source end
561 {-
562 u = do
563 x <- src
564 y <- src
565 -}
566 u = src `UF.bind` \x ->
567 src `UF.bind` \y ->
568 let s = x + y
569 in if s > 1100000
570 then UF.fromPure s
571 else UF.nilM (return . const ())
572 in UF.fold FL.drain u start
574{-# INLINE breakAfterSome #-}
575breakAfterSome :: Int -> Int -> IO ()
576breakAfterSome value start =
577 let end = start + nthRoot 2 value
578 src = source end
579 {-
580 u = do
581 x <- src
582 y <- src
583 -}
584 u = src `UF.bind` \x ->
585 src `UF.bind` \y ->
586 let s = x + y
587 in if s > 1100000
588 then error "break"
589 else UF.fromPure s
590 in do
591 (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start
592 return ()
594-------------------------------------------------------------------------------
595-- Benchmark ops
596-------------------------------------------------------------------------------
598-- n * (n + 1) / 2 == linearCount
599concatCount :: Int -> Int
600concatCount linearCount =
601 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
603{-# INLINE concat #-}
604concat :: Monad m => Int -> Int -> m ()
605concat linearCount start = do
606 let end = start + concatCount linearCount
607 UF.fold FL.drain (UF.many (source end) (source end)) start
609-------------------------------------------------------------------------------
610-- Benchmarks
611-------------------------------------------------------------------------------
613moduleName :: String
614moduleName = "Data.Unfold"
616o_1_space_transformation_input :: Int -> [Benchmark]
617o_1_space_transformation_input size =
618 [ bgroup
619 "transformation/input"
620 [ benchIO "lmap" $ lmap size
621 , benchIO "lmapM" $ lmapM size
622 , benchIO "both" $ both size
623 , benchIO "first" $ first size
624 , benchIO "second" $ second size
625 , benchIO "discardFirst" $ discardFirst size
626 , benchIO "discardSecond" $ discardSecond size
627 , benchIO "swap" $ swap size
628 ]
629 ]
631o_1_space_generation :: Int -> [Benchmark]
632o_1_space_generation size =
633 [ bgroup
634 "generation"
635 [ benchIO "fromStream" $ fromStream size
636 , benchIO "fromStreamK" $ fromStreamK size
637 , benchIO "fromStreamD" $ fromStreamD size
638 -- Very small benchmarks, reporting in ns
639 -- , benchIO "nilM" $ nilM size
640 , benchIO "consM" $ consM size
641 -- , benchIO "functionM" $ functionM size
642 -- , benchIO "function" $ function size
643 -- , benchIO "identity" $ identity size
644 -- , benchIO "const" $ const size
645 , benchIO "unfoldrM" $ unfoldrM size
646 , benchIO "fromList" $ fromList size
647 , benchIO "fromListM" $ fromListM size
648 -- Unimplemented
649 -- , benchIO "fromSVar" $ fromSVar size
650 -- , benchIO "fromProducer" $ fromProducer size
651 , benchIO "replicateM" $ replicateM size
652 , benchIO "repeatM" $ repeatM size
653 , benchIO "iterateM" $ iterateM size
654 , benchIO "fromIndicesM" $ fromIndicesM size
655 , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size
656 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
657 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
658 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
659 , benchIO "enumerateFromNum" $ enumerateFromNum size
660 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
661 ]
662 ]
664o_1_space_transformation :: Int -> [Benchmark]
665o_1_space_transformation size =
666 [ bgroup
667 "transformation"
668 [ benchIO "map" $ map size
669 , benchIO "mapM" $ mapM size
670 , benchIO "mapMWithInput" $ mapMWithInput size
671 , benchIO "postscan" $ postscan size
672 ]
673 ]
675o_1_space_filtering :: Int -> [Benchmark]
676o_1_space_filtering size =
677 [ bgroup
678 "filtering"
679 [ benchIO "takeWhileM" $ takeWhileM size
680 , benchIO "takeWhile" $ takeWhile size
681 , benchIO "take" $ take size
682 , benchIO "filter" $ filter size
683 , benchIO "filterM" $ filterM size
684 -- Very small benchmark, reporting in ns
685 -- , benchIO "dropOne" $ dropOne size
686 , benchIO "dropAll" $ dropAll size
687 , benchIO "dropWhileTrue" $ dropWhileTrue size
688 , benchIO "dropWhileFalse" $ dropWhileFalse size
689 , benchIO "dropWhileMTrue" $ dropWhileMTrue size
690 , benchIO "dropWhileMFalse" $ dropWhileMFalse size
691 ]
692 ]
694o_1_space_zip :: Int -> [Benchmark]
695o_1_space_zip size =
696 [ bgroup
697 "zip"
698 [ benchIO "zipWithM" $ zipWithM size
699 , benchIO "zipWith" $ zipWith size
700 , benchIO "teeZipWith" $ teeZipWith size
701 ]
702 ]
704lf :: Word8
705lf = fromIntegral (ord '\n')
707-- | Split on line feed.
708foldManySepBy :: Handle -> IO Int
709foldManySepBy =
710 let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.read
711 in UF.fold FL.length u
713o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
714o_1_space_nested env size =
715 [ bgroup
716 "nested"
717 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
718 -- Unimplemented
719 -- , benchIO "apDiscardFst" $ apDiscardFst size
720 -- , benchIO "apDiscardSnd" $ apDiscardSnd size
722 , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size
723 , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size
724 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size
725 , benchIO "breakAfterSome" $ breakAfterSome size
726 , benchIO "filterAllOut" $ filterAllOut size
727 , benchIO "filterAllIn" $ filterAllIn size
728 , benchIO "filterSome" $ filterSome size
730 , benchIO "concat" $ concat size
731 , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
732 $ \inh _ -> foldManySepBy inh
733 ]
734 ]
736o_n_space_nested :: Int -> [Benchmark]
737o_n_space_nested size =
738 [ bgroup
739 "nested"
740 [ benchIO "toList" $ toList size
741 , benchIO "toListSome" $ toListSome size
742 ]
743 ]
745-------------------------------------------------------------------------------
746-- Unfold Exception Benchmarks
747-------------------------------------------------------------------------------
748-- | Send the file contents to /dev/null with exception handling
749readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
750readWriteOnExceptionUnfold inh devNull =
751 let readEx = UF.onException (\_ -> hClose inh) FH.read
752 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
754#ifdef INSPECTION
755inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
756-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
757#endif
759-- | Send the file contents to /dev/null with exception handling
760readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
761readWriteHandleExceptionUnfold inh devNull =
762 let handler (_e :: SomeException) = hClose inh >> return 10
763 readEx = UF.handle (UF.functionM handler) FH.read
764 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
766#ifdef INSPECTION
767inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
768-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
769#endif
771-- | Send the file contents to /dev/null with exception handling
772readWriteFinally_Unfold :: Handle -> Handle -> IO ()
773readWriteFinally_Unfold inh devNull =
774 let readEx = UF.finally_ (\_ -> hClose inh) FH.read
775 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
777#ifdef INSPECTION
778inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
779-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
780#endif
782readWriteFinallyUnfold :: Handle -> Handle -> IO ()
783readWriteFinallyUnfold inh devNull =
784 let readEx = UF.finally (\_ -> hClose inh) FH.read
785 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
787-- | Send the file contents to /dev/null with exception handling
788readWriteBracket_Unfold :: Handle -> Handle -> IO ()
789readWriteBracket_Unfold inh devNull =
790 let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
791 in SP.fold (FH.write devNull) $ SP.unfold readEx inh
793#ifdef INSPECTION
794inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
795-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
796#endif
798readWriteBracketUnfold :: Handle -> Handle -> IO ()
799readWriteBracketUnfold inh devNull =
800 let readEx = UF.bracket return (\_ -> hClose inh) FH.read
801 in SP.fold (FH.write devNull) $ S.unfold readEx inh
803o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
804o_1_space_copy_read_exceptions env =
805 [ bgroup "exceptions"
806 [ mkBenchSmall "UF.onException" env $ \inh _ ->
807 readWriteOnExceptionUnfold inh (nullH env)
808 , mkBenchSmall "UF.handle" env $ \inh _ ->
809 readWriteHandleExceptionUnfold inh (nullH env)
810 , mkBenchSmall "UF.finally_" env $ \inh _ ->
811 readWriteFinally_Unfold inh (nullH env)
812 , mkBenchSmall "UF.finally" env $ \inh _ ->
813 readWriteFinallyUnfold inh (nullH env)
814 , mkBenchSmall "UF.bracket_" env $ \inh _ ->
815 readWriteBracket_Unfold inh (nullH env)
816 , mkBenchSmall "UF.bracket" env $ \inh _ ->
817 readWriteBracketUnfold inh (nullH env)
818 ]
819 ]
822-------------------------------------------------------------------------------
823-- Driver
824-------------------------------------------------------------------------------
826main :: IO ()
827main = do
828 env <- mkHandleBenchEnv
829 runWithCLIOpts defaultStreamSize (allBenchmarks env)
831 where
833 allBenchmarks env size =
834 [ bgroup (o_1_space_prefix moduleName)
835 $ Prelude.concat
836 [ o_1_space_transformation_input size
837 , o_1_space_generation size
838 , o_1_space_transformation size
839 , o_1_space_filtering size
840 , o_1_space_zip size
841 , o_1_space_nested env size
842 , o_1_space_copy_read_exceptions env
843 ]
844 , bgroup (o_n_space_prefix moduleName)
845 $ Prelude.concat [o_n_space_nested size]
846 ]