@@ -1,2075 +1,29 @@
2−-- Module : Main
2+-- Module : Serial
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
5−-- License : BSD3
4+-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
8{-# LANGUAGE CPP #-}
7{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
14−{-# LANGUAGE TupleSections #-}
16−#ifdef __HADDOCK_VERSION__
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
27−import Control.DeepSeq (NFData(..))
12+module Main (main) where
28−import Control.Monad (when)
29−import Control.Monad.IO.Class (MonadIO(..))
30−import Control.Monad.State.Strict (StateT, get, put, MonadState)
31−import qualified Control.Monad.State.Strict as State
32−import Control.Monad.Trans.Class (lift)
33−import Data.Functor.Identity (Identity, runIdentity)
34−import Data.IORef (newIORef, modifyIORef')
35−import GHC.Generics (Generic)
36−import System.Random (randomRIO)
38− ( concatMap, mapM_, init, last, elem, notElem, all, any
39− , and, or, length, sum, product, maximum, minimum, reverse, fmap, map
40− , sequence, mapM, tail, repeat, replicate, iterate, (!!), lookup)
42−import qualified Control.Applicative as AP
14+import qualified Serial.Generation as Generation
43−import qualified Prelude as P
44−import qualified Data.Foldable as F
45−import qualified GHC.Exts as GHC
15+import qualified Serial.Elimination as Elimination
46−
16+import qualified Serial.Transformation1 as Transformation1
47−#ifdef INSPECTION
17+import qualified Serial.Transformation2 as Transformation2
48−import GHC.Types (SPEC(..))
18+import qualified Serial.Transformation3 as Transformation3
49−import Test.Inspection
51−import qualified Streamly.Internal.Data.Stream.StreamD as D
54−import qualified Streamly.Prelude as S
55−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
56−import qualified Streamly.Internal.Data.Fold as FL
57−import qualified Streamly.Internal.Data.Unfold as UF
19+import qualified Serial.Nested as Nested
59import Gauge
21import Gauge
60−import Streamly.Prelude (SerialT, IsStream, serially, serial, MonadAsync)
61import Streamly.Benchmark.Common
22import Streamly.Benchmark.Common
62−import Streamly.Benchmark.Prelude
63−import Streamly.Internal.Data.Time.Units
65moduleName :: String
24moduleName :: String
66moduleName = "Prelude.Serial"
25moduleName = "Prelude.Serial"
68−-------------------------------------------------------------------------------
70−-------------------------------------------------------------------------------
72−-------------------------------------------------------------------------------
74−-------------------------------------------------------------------------------
76−{-# INLINE sourceIsList #-}
77−sourceIsList :: Int -> Int -> SerialT Identity Int
78−sourceIsList value n = GHC.fromList [n..n+value]
80−{-# INLINE sourceIsString #-}
81−sourceIsString :: Int -> Int -> SerialT Identity P.Char
82−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
84−{-# INLINE readInstance #-}
85−readInstance :: P.String -> SerialT Identity Int
90− _ -> P.error "readInstance: no parse"
93−{-# INLINE readInstanceList #-}
94−readInstanceList :: P.String -> [Int]
95−readInstanceList str =
99− _ -> P.error "readInstance: no parse"
101−{-# INLINE repeat #-}
102−repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
103−repeat count = S.take count . S.repeat
105−{-# INLINE repeatM #-}
106−repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
107−repeatM count = S.take count . S.repeatM . return
109−{-# INLINE replicate #-}
110−replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
111−replicate count = S.replicate count
113−{-# INLINE replicateM #-}
114−replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
115−replicateM count = S.replicateM count . return
117−{-# INLINE enumerateFrom #-}
118−enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
119−enumerateFrom count = S.take count . S.enumerateFrom
121−{-# INLINE enumerateFromTo #-}
122−enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
123−enumerateFromTo = sourceIntFromTo
125−{-# INLINE enumerateFromThen #-}
126−enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
127−enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)
129−{-# INLINE enumerateFromThenTo #-}
130−enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
131−enumerateFromThenTo = sourceIntFromThenTo
134−{-# INLINE enumerate #-}
135−enumerate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
136−enumerate count n = S.take (count + n) $ S.enumerate
139−{-# INLINE enumerateTo #-}
140−enumerateTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
141−enumerateTo count n = S.enumerateTo (minBound + count + n)
143−{-# INLINE iterate #-}
144−iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
145−iterate count = S.take count . S.iterate (+1)
147−{-# INLINE iterateM #-}
148−iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
149−iterateM count = S.take count . S.iterateM (return . (+1)) . return
151−{-# INLINE fromIndices #-}
152−fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
153−fromIndices value n = S.take value $ S.fromIndices (+ n)
155−{-# INLINE fromIndicesM #-}
156−fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
157−fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
159−o_1_space_generation :: Int -> [Benchmark]
160−o_1_space_generation value =
161− [ bgroup "generation"
162− [ benchIOSrc serially "unfoldr" (sourceUnfoldr value)
163− , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
164− , benchIOSrc serially "repeat" (repeat value)
165− , benchIOSrc serially "repeatM" (repeatM value)
166− , benchIOSrc serially "replicate" (replicate value)
167− , benchIOSrc serially "replicateM" (replicateM value)
168− , benchIOSrc serially "iterate" (iterate value)
169− , benchIOSrc serially "iterateM" (iterateM value)
170− , benchIOSrc serially "fromIndices" (fromIndices value)
171− , benchIOSrc serially "fromIndicesM" (fromIndicesM value)
172− , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
173− , benchIOSrc serially "intFromThenTo" (sourceIntFromThenTo value)
174− , benchIOSrc serially "integerFromStep" (sourceIntegerFromStep value)
175− , benchIOSrc serially "fracFromThenTo" (sourceFracFromThenTo value)
176− , benchIOSrc serially "fracFromTo" (sourceFracFromTo value)
177− , benchIOSrc serially "fromList" (sourceFromList value)
178− , benchPureSrc "IsList.fromList" (sourceIsList value)
179− , benchPureSrc "IsString.fromString" (sourceIsString value)
180− , benchIOSrc serially "fromListM" (sourceFromListM value)
181− , benchIOSrc serially "enumerateFrom" (enumerateFrom value)
182− , benchIOSrc serially "enumerateFromThen" (enumerateFromThen value)
183− , benchIOSrc serially "enumerate" (enumerate value)
184− , benchIOSrc serially "enumerateTo" (enumerateTo value)
186− -- These essentially test cons and consM
187− , benchIOSrc serially "fromFoldable" (sourceFromFoldable value)
188− , benchIOSrc serially "fromFoldableM" (sourceFromFoldableM value)
190− , benchIOSrc serially "absTimes" $ absTimes value
194−o_n_heap_generation :: Int -> [Benchmark]
195−o_n_heap_generation value =
197− -- Buffers the output of show/read.
198− -- XXX can the outputs be streaming? Can we have special read/show
199− -- style type classes, readM/showM supporting streaming effects?
200− [ bench "readsPrec pure streams" $
201− nf readInstance (mkString value)
202− , bench "readsPrec Haskell lists" $
203− nf readInstanceList (mkListString value)
207−-------------------------------------------------------------------------------
209−-------------------------------------------------------------------------------
211−-------------------------------------------------------------------------------
213−-------------------------------------------------------------------------------
215−{-# INLINE foldableFoldl' #-}
216−foldableFoldl' :: Int -> Int -> Int
217−foldableFoldl' value n =
218− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
220−{-# INLINE foldableFoldrElem #-}
221−foldableFoldrElem :: Int -> Int -> Bool
222−foldableFoldrElem value n =
223− F.foldr (\x xs -> x == value || xs)
225− (sourceUnfoldr value n :: S.SerialT Identity Int)
227−{-# INLINE foldableSum #-}
228−foldableSum :: Int -> Int -> Int
229−foldableSum value n =
230− P.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
232−{-# INLINE foldableProduct #-}
233−foldableProduct :: Int -> Int -> Int
234−foldableProduct value n =
235− P.product (sourceUnfoldr value n :: S.SerialT Identity Int)
237−{-# INLINE _foldableNull #-}
238−_foldableNull :: Int -> Int -> Bool
239−_foldableNull value n =
240− P.null (sourceUnfoldr value n :: S.SerialT Identity Int)
242−{-# INLINE foldableElem #-}
243−foldableElem :: Int -> Int -> Bool
244−foldableElem value n =
245− value `P.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
247−{-# INLINE foldableNotElem #-}
248−foldableNotElem :: Int -> Int -> Bool
249−foldableNotElem value n =
250− value `P.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
252−{-# INLINE foldableFind #-}
253−foldableFind :: Int -> Int -> Maybe Int
254−foldableFind value n =
255− F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
257−{-# INLINE foldableAll #-}
258−foldableAll :: Int -> Int -> Bool
259−foldableAll value n =
260− P.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
262−{-# INLINE foldableAny #-}
263−foldableAny :: Int -> Int -> Bool
264−foldableAny value n =
265− P.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
267−{-# INLINE foldableAnd #-}
268−foldableAnd :: Int -> Int -> Bool
269−foldableAnd value n =
271− (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
273−{-# INLINE foldableOr #-}
274−foldableOr :: Int -> Int -> Bool
277− (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
279−{-# INLINE foldableLength #-}
280−foldableLength :: Int -> Int -> Int
281−foldableLength value n =
282− P.length (sourceUnfoldr value n :: S.SerialT Identity Int)
284−{-# INLINE foldableMin #-}
285−foldableMin :: Int -> Int -> Int
286−foldableMin value n =
287− P.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
289−{-# INLINE ordInstanceMin #-}
290−ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
291−ordInstanceMin src = P.min src src
293−{-# INLINE foldableMax #-}
294−foldableMax :: Int -> Int -> Int
295−foldableMax value n =
296− P.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
298−{-# INLINE foldableMinBy #-}
299−foldableMinBy :: Int -> Int -> Int
300−foldableMinBy value n =
301− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
303−{-# INLINE foldableListMinBy #-}
304−foldableListMinBy :: Int -> Int -> Int
305−foldableListMinBy value n = F.minimumBy compare [1..value+n]
307−{-# INLINE foldableMaxBy #-}
308−foldableMaxBy :: Int -> Int -> Int
309−foldableMaxBy value n =
310− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
312−{-# INLINE foldableToList #-}
313−foldableToList :: Int -> Int -> [Int]
314−foldableToList value n =
315− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
317−{-# INLINE foldableMapM_ #-}
318−foldableMapM_ :: Monad m => Int -> Int -> m ()
319−foldableMapM_ value n =
320− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
322−{-# INLINE foldableSequence_ #-}
323−foldableSequence_ :: Int -> Int -> IO ()
324−foldableSequence_ value n =
325− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
327−{-# INLINE _foldableMsum #-}
328−_foldableMsum :: Int -> Int -> IO Int
329−_foldableMsum value n =
330− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
332−{-# INLINE showInstance #-}
333−showInstance :: SerialT Identity Int -> P.String
334−showInstance = P.show
336−o_1_space_elimination_foldable :: Int -> [Benchmark]
337−o_1_space_elimination_foldable value =
339− -- Foldable instance
340− [ bench "foldl'" $ nf (foldableFoldl' value) 1
341− , bench "foldrElem" $ nf (foldableFoldrElem value) 1
342− -- , bench "null" $ nf (_foldableNull value) 1
343− , bench "elem" $ nf (foldableElem value) 1
344− , bench "length" $ nf (foldableLength value) 1
345− , bench "sum" $ nf (foldableSum value) 1
346− , bench "product" $ nf (foldableProduct value) 1
347− , bench "minimum" $ nf (foldableMin value) 1
348− , benchPureSink value "min (ord)" ordInstanceMin
349− , bench "maximum" $ nf (foldableMax value) 1
350− , bench "length . toList" $ nf (P.length . foldableToList value) 1
351− , bench "notElem" $ nf (foldableNotElem value) 1
352− , bench "find" $ nf (foldableFind value) 1
353− , bench "all" $ nf (foldableAll value) 1
354− , bench "any" $ nf (foldableAny value) 1
355− , bench "and" $ nf (foldableAnd value) 1
356− , bench "or" $ nf (foldableOr value) 1
358− -- Applicative and Traversable operations
360− , benchIOSink1 "mapM_" (foldableMapM_ value)
363− , benchIOSink1 "sequence_" (foldableSequence_ value)
366− -- XXX needs to be fixed, results are in ns
367− -- , benchIOSink1 "msum" (foldableMsum value)
371−o_n_space_elimination_foldable :: Int -> [Benchmark]
372−o_n_space_elimination_foldable value =
373− -- Head recursive strict right folds.
375− -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
376− -- foldl1 which does not work in constant memory for our
377− -- implementation. It works in constant memory for lists but even for
378− -- lists it takes 15x more time compared to our foldl' based
380− [ bench "minimumBy" $ nf (`foldableMinBy` 1) value
381− , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
382− , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
386−-------------------------------------------------------------------------------
388−-------------------------------------------------------------------------------
390−{-# INLINE benchPureSink #-}
391−benchPureSink :: NFData b
392− => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
393−benchPureSink value name = benchPure name (sourceUnfoldr value)
395−{-# INLINE benchHoistSink #-}
397− :: (IsStream t, NFData b)
398− => Int -> String -> (t Identity Int -> IO b) -> Benchmark
399−benchHoistSink value name f =
400− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
402−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
403−-- we can't use it as it requires MonadAsync constraint.
404−{-# INLINE benchIdentitySink #-}
406− :: (IsStream t, NFData b)
407− => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
408−benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
410−-------------------------------------------------------------------------------
412−-------------------------------------------------------------------------------
414−{-# INLINE uncons #-}
415−uncons :: Monad m => SerialT m Int -> m ()
419− Nothing -> return ()
420− Just (_, t) -> uncons t
423−init :: Monad m => SerialT m a -> m ()
424−init s = S.init s >>= P.mapM_ S.drain
427−mapM_ :: Monad m => SerialT m Int -> m ()
428−mapM_ = S.mapM_ (\_ -> return ())
430−{-# INLINE foldrMElem #-}
431−foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
440−{-# INLINE foldrToStream #-}
441−foldrToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)
442−foldrToStream = S.foldr S.cons S.nil
444−{-# INLINE foldrMBuild #-}
445−foldrMBuild :: Monad m => SerialT m Int -> m [Int]
446−foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
448−{-# INLINE foldl'Reduce #-}
449−foldl'Reduce :: Monad m => SerialT m Int -> m Int
450−foldl'Reduce = S.foldl' (+) 0
452−{-# INLINE foldl1'Reduce #-}
453−foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)
454−foldl1'Reduce = S.foldl1' (+)
456−{-# INLINE foldlM'Reduce #-}
457−foldlM'Reduce :: Monad m => SerialT m Int -> m Int
458−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
461−last :: Monad m => SerialT m Int -> m (Maybe Int)
465−_head :: Monad m => SerialT m Int -> m (Maybe Int)
469−elem :: Monad m => Int -> SerialT m Int -> m Bool
470−elem value = S.elem (value + 1)
472−{-# INLINE notElem #-}
473−notElem :: Monad m => Int -> SerialT m Int -> m Bool
474−notElem value = S.notElem (value + 1)
476−{-# INLINE length #-}
477−length :: Monad m => SerialT m Int -> m Int
481−all :: Monad m => Int -> SerialT m Int -> m Bool
482−all value = S.all (<= (value + 1))
485−any :: Monad m => Int -> SerialT m Int -> m Bool
486−any value = S.any (> (value + 1))
489−and :: Monad m => Int -> SerialT m Int -> m Bool
490−and value = S.and . S.map (<= (value + 1))
493−or :: Monad m => Int -> SerialT m Int -> m Bool
494−or value = S.or . S.map (> (value + 1))
497−find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
498−find value = S.find (== (value + 1))
501−findM :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
502−findM value = S.findM (\z -> return $ z == (value + 1))
504−{-# INLINE findIndex #-}
505−findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
506−findIndex value = S.findIndex (== (value + 1))
508−{-# INLINE elemIndex #-}
509−elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
510−elemIndex value = S.elemIndex (value + 1)
512−{-# INLINE maximum #-}
513−maximum :: Monad m => SerialT m Int -> m (Maybe Int)
516−{-# INLINE minimum #-}
517−minimum :: Monad m => SerialT m Int -> m (Maybe Int)
521−sum :: Monad m => SerialT m Int -> m Int
524−{-# INLINE product #-}
525−product :: Monad m => SerialT m Int -> m Int
528−{-# INLINE minimumBy #-}
529−minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)
530−minimumBy = S.minimumBy compare
532−{-# INLINE maximumBy #-}
533−maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
534−maximumBy = S.maximumBy compare
537−the :: Monad m => SerialT m Int -> m (Maybe Int)
540−{-# INLINE drainN #-}
541−drainN :: Monad m => Int -> SerialT m Int -> m ()
542−drainN val = S.drainN val
544−{-# INLINE drainWhile #-}
545−drainWhile :: Monad m => SerialT m Int -> m ()
546−drainWhile = S.drainWhile (const True)
549−(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
550−(!!) val = flip (Internal.!!) val
552−{-# INLINE lookup #-}
553−lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
554−lookup val = S.lookup val . S.map (\x -> (x, x))
556−o_1_space_elimination_folds :: Int -> [Benchmark]
557−o_1_space_elimination_folds value =
558− [ bgroup "elimination"
563− [ benchIOSink value "foldl'" foldl'Reduce
564− , benchIOSink value "foldl1'" foldl1'Reduce
565− , benchIOSink value "foldlM'" foldlM'Reduce
569− [ benchIdentitySink value "foldl'" foldl'Reduce
570− , benchIdentitySink value "foldl1'" foldl1'Reduce
571− , benchIdentitySink value "foldlM'" foldlM'Reduce
576− [ benchIOSink value "foldrMElem" (foldrMElem value)
579− [ benchIdentitySink value "foldrMElem" (foldrMElem value)
580− , benchIdentitySink value "foldrToStreamLength"
581− (S.length . runIdentity . foldrToStream)
582− , benchPureSink value "foldrMToListLength"
583− (P.length . runIdentity . foldrMBuild)
588− , benchIOSink value "uncons" uncons
589− , benchIOSink value "init" init
592− , benchIOSink value "drain" $ toNull serially
593− , benchIOSink value "drainN" $ drainN value
594− , benchIOSink value "drainWhile" $ drainWhile
595− , benchPureSink value "drain (pure)" P.id
596− , benchIOSink value "mapM_" mapM_
598− -- this is too fast, causes all benchmarks reported in ns
599− -- , benchIOSink value "head" head
600− , benchIOSink value "last" last
601− , benchIOSink value "length" length
602− , benchHoistSink value "length . generally"
603− (length . Internal.generally)
604− , benchIOSink value "sum" sum
605− , benchIOSink value "product" product
606− , benchIOSink value "maximumBy" maximumBy
607− , benchIOSink value "maximum" maximum
608− , benchIOSink value "minimumBy" minimumBy
609− , benchIOSink value "minimum" minimum
611− , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
612− , benchIOSink value "find" (find value)
613− , benchIOSink value "findM" (findM value)
614− -- , benchIOSink value "lookupFirst" (lookup 1)
615− , benchIOSink value "lookupNever" (lookup (value + 1))
616− , benchIOSink value "(!!)" ((!!) value)
617− , benchIOSink value "findIndex" (findIndex value)
618− , benchIOSink value "elemIndex" (elemIndex value)
619− -- this is too fast, causes all benchmarks reported in ns
620− -- , benchIOSink value "null" S.null
621− , benchIOSink value "elem" (elem value)
622− , benchIOSink value "notElem" (notElem value)
623− , benchIOSink value "all" (all value)
624− , benchIOSink value "any" (any value)
625− , benchIOSink value "and" (and value)
626− , benchIOSink value "or" (or value)
628− , benchPureSink value "showsPrec pure streams" showInstance
629− -- length is used to check for foldr/build fusion
630− , benchPureSink value "length . IsList.toList" (P.length . GHC.toList)
634−-------------------------------------------------------------------------------
635−-- Buffered Transformations by fold
636−-------------------------------------------------------------------------------
638−{-# INLINE foldl'Build #-}
639−foldl'Build :: Monad m => SerialT m Int -> m [Int]
640−foldl'Build = S.foldl' (flip (:)) []
642−{-# INLINE foldlM'Build #-}
643−foldlM'Build :: Monad m => SerialT m Int -> m [Int]
644−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
646−o_n_heap_elimination_foldl :: Int -> [Benchmark]
647−o_n_heap_elimination_foldl value =
649− -- Left folds for building a structure are inherently non-streaming
650− -- as the structure cannot be lazily consumed until fully built.
651− [ benchIOSink value "foldl'/build/IO" foldl'Build
652− , benchIdentitySink value "foldl'/build/Identity" foldl'Build
653− , benchIOSink value "foldlM'/build/IO" foldlM'Build
654− , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
659−{-# INLINE showInstanceList #-}
660−showInstanceList :: [Int] -> P.String
661−showInstanceList = P.show
663−o_n_heap_elimination_buffered :: Int -> [Benchmark]
664−o_n_heap_elimination_buffered value =
666− -- Buffers the output of show/read.
667− -- XXX can the outputs be streaming? Can we have special read/show
668− -- style type classes, readM/showM supporting streaming effects?
669− [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)
673−{-# INLINE foldrMReduce #-}
674−foldrMReduce :: Monad m => SerialT m Int -> m Int
675−foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
677−o_n_space_elimination_foldr :: Int -> [Benchmark]
678−o_n_space_elimination_foldr value =
679− -- Head recursive strict right folds.
681− -- accumulation due to strictness of IO monad
682− [ benchIOSink value "foldrM/build/IO (toList)" foldrMBuild
683− -- Right folds for reducing are inherently non-streaming as the
684− -- expression needs to be fully built before it can be reduced.
685− , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce
686− , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
690−o_n_heap_elimination_toList :: Int -> [Benchmark]
691−o_n_heap_elimination_toList value =
693− -- Converting the stream to a list or pure stream in a strict monad
694− [ benchIOSink value "toListRev" Internal.toListRev
695− , benchIOSink value "toPureRev" Internal.toPureRev
699−o_n_space_elimination_toList :: Int -> [Benchmark]
700−o_n_space_elimination_toList value =
702− -- Converting the stream to a list or pure stream in a strict monad
703− [ benchIOSink value "toList" S.toList
704− , benchIOSink value "toPure" Internal.toPure
708−-------------------------------------------------------------------------------
709−-- Multi-stream folds
710−-------------------------------------------------------------------------------
712−-------------------------------------------------------------------------------
714−-------------------------------------------------------------------------------
717−eqBy' :: (Monad m, P.Eq a) => SerialT m a -> m P.Bool
718−eqBy' src = S.eqBy (==) src src
720−{-# INLINE eqByPure #-}
721−eqByPure :: Int -> Int -> Identity Bool
722−eqByPure value n = eqBy' (sourceUnfoldr value n)
725−inspect $ hasNoTypeClasses 'eqByPure
726−inspect $ 'eqByPure `hasNoType` ''SPEC
727−inspect $ 'eqByPure `hasNoType` ''D.Step
730−{-# INLINE eqInstance #-}
731−eqInstance :: SerialT Identity Int -> Bool
732−eqInstance src = src == src
734−{-# INLINE eqInstanceNotEq #-}
735−eqInstanceNotEq :: SerialT Identity Int -> Bool
736−eqInstanceNotEq src = src P./= src
738−{-# INLINE cmpBy' #-}
739−cmpBy' :: (Monad m, P.Ord a) => SerialT m a -> m P.Ordering
740−cmpBy' src = S.cmpBy P.compare src src
742−{-# INLINE cmpByPure #-}
743−cmpByPure :: Int -> Int -> Identity P.Ordering
744−cmpByPure value n = cmpBy' (sourceUnfoldr value n)
747−inspect $ hasNoTypeClasses 'cmpByPure
748−inspect $ 'cmpByPure `hasNoType` ''SPEC
749−inspect $ 'cmpByPure `hasNoType` ''D.Step
752−{-# INLINE ordInstance #-}
753−ordInstance :: SerialT Identity Int -> Bool
754−ordInstance src = src P.< src
756−o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
757−o_1_space_elimination_multi_stream_pure value =
758− [ bgroup "multi-stream-pure"
759− [ benchPureSink1 "eqBy" (eqByPure value)
760− , benchPureSink value "==" eqInstance
761− , benchPureSink value "/=" eqInstanceNotEq
762− , benchPureSink1 "cmpBy" (cmpByPure value)
763− , benchPureSink value "<" ordInstance
767−{-# INLINE isPrefixOf #-}
768−isPrefixOf :: Monad m => SerialT m Int -> m Bool
769−isPrefixOf src = S.isPrefixOf src src
771−{-# INLINE isSubsequenceOf #-}
772−isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
773−isSubsequenceOf src = S.isSubsequenceOf src src
775−{-# INLINE stripPrefix #-}
776−stripPrefix :: Monad m => SerialT m Int -> m ()
778− _ <- S.stripPrefix src src
782−eqBy :: Int -> Int -> IO Bool
783−eqBy value n = eqBy' (sourceUnfoldrM value n)
786−inspect $ hasNoTypeClasses 'eqBy
787−inspect $ 'eqBy `hasNoType` ''SPEC
788−inspect $ 'eqBy `hasNoType` ''D.Step
792−cmpBy :: Int -> Int -> IO P.Ordering
793−cmpBy value n = cmpBy' (sourceUnfoldrM value n)
796−inspect $ hasNoTypeClasses 'cmpBy
797−inspect $ 'cmpBy `hasNoType` ''SPEC
798−inspect $ 'cmpBy `hasNoType` ''D.Step
801−o_1_space_elimination_multi_stream :: Int -> [Benchmark]
802−o_1_space_elimination_multi_stream value =
803− [ bgroup "multi-stream"
804− [ benchIOSink1 "eqBy" (eqBy value)
805− , benchIOSink1 "cmpBy" (cmpBy value)
806− , benchIOSink value "isPrefixOf" isPrefixOf
807− , benchIOSink value "isSubsequenceOf" isSubsequenceOf
808− , benchIOSink value "stripPrefix" stripPrefix
812−-------------------------------------------------------------------------------
813−-- Pipelines (stream-to-stream transformations)
814−-------------------------------------------------------------------------------
816−-------------------------------------------------------------------------------
817−-- one-to-one transformations
818−-------------------------------------------------------------------------------
820−-------------------------------------------------------------------------------
821−-- Traversable Instance
822−-------------------------------------------------------------------------------
824−{-# INLINE traversableTraverse #-}
825−traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
826−traversableTraverse = P.traverse return
828−{-# INLINE traversableSequenceA #-}
829−traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
830−traversableSequenceA = P.sequenceA . P.fmap return
832−{-# INLINE traversableMapM #-}
833−traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
834−traversableMapM = P.mapM return
836−{-# INLINE traversableSequence #-}
837−traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
838−traversableSequence = P.sequence . P.fmap return
840−{-# INLINE benchPureSinkIO #-}
843− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
844−benchPureSinkIO value name f =
845− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
847−o_n_space_traversable :: Int -> [Benchmark]
848−o_n_space_traversable value =
849− -- Buffering operations using heap proportional to number of elements.
850− [ bgroup "traversable"
851− -- Traversable instance
852− [ benchPureSinkIO value "traverse" traversableTraverse
853− , benchPureSinkIO value "sequenceA" traversableSequenceA
854− , benchPureSinkIO value "mapM" traversableMapM
855− , benchPureSinkIO value "sequence" traversableSequence
859−-------------------------------------------------------------------------------
861−-------------------------------------------------------------------------------
863−{-# INLINE scanl' #-}
864−scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
865−scanl' n = composeN n $ S.scanl' (+) 0
867−{-# INLINE scanlM' #-}
868−scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
869−scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
871−{-# INLINE scanl1' #-}
872−scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
873−scanl1' n = composeN n $ S.scanl1' (+)
875−{-# INLINE scanl1M' #-}
876−scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
877−scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
880−scan :: MonadIO m => Int -> SerialT m Int -> m ()
881−scan n = composeN n $ S.scan FL.sum
883−{-# INLINE postscanl' #-}
884−postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
885−postscanl' n = composeN n $ S.postscanl' (+) 0
887−{-# INLINE postscanlM' #-}
888−postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
889−postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
891−{-# INLINE postscan #-}
892−postscan :: MonadIO m => Int -> SerialT m Int -> m ()
893−postscan n = composeN n $ S.postscan FL.sum
895−{-# INLINE sequence #-}
897− (S.IsStream t, S.MonadAsync m)
898− => (t m Int -> S.SerialT m Int)
901−sequence t = S.drain . t . S.sequence
904−tap :: MonadIO m => Int -> SerialT m Int -> m ()
905−tap n = composeN n $ S.tap FL.sum
907−{-# INLINE tapRate #-}
908−tapRate :: Int -> SerialT IO Int -> IO ()
911− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
913−{-# INLINE pollCounts #-}
914−pollCounts :: Int -> SerialT IO Int -> IO ()
916− composeN n (Internal.pollCounts (P.const P.True) f FL.drain)
920− f = Internal.rollingMap (P.-) . Internal.delayPost 1
922−{-# INLINE timestamped #-}
923−timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
924−timestamped = S.drain . Internal.timestamped
926−{-# INLINE foldrS #-}
927−foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
928−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
930−{-# INLINE foldrSMap #-}
931−foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
932−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
934−{-# INLINE foldrT #-}
935−foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
936−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
938−{-# INLINE foldrTMap #-}
939−foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
940−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
944−trace :: MonadAsync m => Int -> SerialT m Int -> m ()
945−trace n = composeN n $ Internal.trace return
947−o_1_space_mapping :: Int -> [Benchmark]
948−o_1_space_mapping value =
953− benchIOSink value "foldrS" (foldrS 1)
954− , benchIOSink value "foldrSMap" (foldrSMap 1)
955− , benchIOSink value "foldrT" (foldrT 1)
956− , benchIOSink value "foldrTMap" (foldrTMap 1)
959− , benchIOSink value "map" (mapN serially 1)
960− , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
961− sequence serially (sourceUnfoldrAction value n)
962− , benchIOSink value "mapM" (mapM serially 1)
963− , benchIOSink value "tap" (tap 1)
964− , benchIOSink value "tapRate 1 second" (tapRate 1)
965− , benchIOSink value "pollCounts 1 second" (pollCounts 1)
966− , benchIOSink value "timestamped" timestamped
969− , benchIOSink value "scanl'" (scanl' 1)
970− , benchIOSink value "scanl1'" (scanl1' 1)
971− , benchIOSink value "scanlM'" (scanlM' 1)
972− , benchIOSink value "scanl1M'" (scanl1M' 1)
973− , benchIOSink value "postscanl'" (postscanl' 1)
974− , benchIOSink value "postscanlM'" (postscanlM' 1)
976− , benchIOSink value "scan" (scan 1)
977− , benchIOSink value "postscan" (postscan 1)
981−o_1_space_mappingX4 :: Int -> [Benchmark]
982−o_1_space_mappingX4 value =
983− [ bgroup "mappingX4"
984− [ benchIOSink value "map" (mapN serially 4)
985− , benchIOSink value "mapM" (mapM serially 4)
986− , benchIOSink value "trace" (trace 4)
988− , benchIOSink value "scanl'" (scanl' 4)
989− , benchIOSink value "scanl1'" (scanl1' 4)
990− , benchIOSink value "scanlM'" (scanlM' 4)
991− , benchIOSink value "scanl1M'" (scanl1M' 4)
992− , benchIOSink value "postscanl'" (postscanl' 4)
993− , benchIOSink value "postscanlM'" (postscanlM' 4)
998−{-# INLINE sieveScan #-}
999−sieveScan :: Monad m => SerialT m Int -> SerialT m Int
1002− . S.scanlM' (\(primes, _) n -> do
1004− let ps = takeWhile (\p -> p * p <= n) primes
1005− in if P.all (\p -> n `mod` p /= 0) ps
1006− then (primes ++ [n], Just n)
1007− else (primes, Nothing)) (return ([2], Just 2))
1009−o_n_space_mapping :: Int -> [Benchmark]
1010−o_n_space_mapping value =
1012− [ benchIO "naive prime sieve"
1013− (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
1017−-------------------------------------------------------------------------------
1018−-- Iteration/looping utilities
1019−-------------------------------------------------------------------------------
1021−{-# INLINE iterateN #-}
1022−iterateN :: (Int -> a -> a) -> a -> Int -> a
1023−iterateN g initial count = f count initial
1028− f i x = f (i - 1) (g i x)
1030−-- Iterate a transformation over a singleton stream
1031−{-# INLINE iterateSingleton #-}
1032−iterateSingleton :: S.MonadAsync m
1033− => (Int -> SerialT m Int -> SerialT m Int)
1037−iterateSingleton g count n = iterateN g (return n) count
1039−-- XXX need to check why this is slower than the explicit recursion above, even
1040−-- if the above code is written in a foldr like head recursive way. We also
1041−-- need to try this with foldlM' once #150 is fixed.
1042−-- However, it is perhaps best to keep the iteration benchmarks independent of
1043−-- foldrM and any related fusion issues.
1044−{-# INLINE _iterateSingleton #-}
1045−_iterateSingleton ::
1047− => (Int -> SerialT m Int -> SerialT m Int)
1051−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
1053−-- Apply transformation g count times on a stream of length len
1054−{-# INLINE iterateSource #-}
1057− => (SerialT m Int -> SerialT m Int)
1062−iterateSource g count len n = f count (sourceUnfoldrM len n)
1066− f (0 :: Int) stream = stream
1067− f i stream = f (i - 1) (g stream)
1069−-------------------------------------------------------------------------------
1071−-------------------------------------------------------------------------------
1073−o_1_space_functor :: Int -> [Benchmark]
1074−o_1_space_functor value =
1076− [ benchIOSink value "fmap" (fmapN serially 1)
1077− , benchIOSink value "fmap x 4" (fmapN serially 4)
1081−o_n_space_functor :: Int -> [Benchmark]
1082−o_n_space_functor value =
1084− [ benchIO "(+) (n times) (baseline)" $ \i0 ->
1085− iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
1086− , benchIOSrc serially "(<$) (n times)" $
1087− iterateSingleton (<$) value
1088− , benchIOSrc serially "fmap (n times)" $
1089− iterateSingleton (P.fmap . (+)) value
1091− , benchIOSrc serially "_(<$) (n times)" $
1092− _iterateSingleton (<$) value
1093− , benchIOSrc serially "_fmap (n times)" $
1094− _iterateSingleton (P.fmap . (+)) value
1099−-------------------------------------------------------------------------------
1100−-- Size reducing transformations (filtering)
1101−-------------------------------------------------------------------------------
1103−{-# INLINE filterEven #-}
1104−filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
1105−filterEven n = composeN n $ S.filter even
1107−{-# INLINE filterAllOut #-}
1108−filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1109−filterAllOut value n = composeN n $ S.filter (> (value + 1))
1111−{-# INLINE filterAllIn #-}
1112−filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1113−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
1115−{-# INLINE filterMEven #-}
1116−filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
1117−filterMEven n = composeN n $ S.filterM (return . even)
1119−{-# INLINE filterMAllOut #-}
1120−filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1121−filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
1123−{-# INLINE filterMAllIn #-}
1124−filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1125−filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
1127−{-# INLINE _takeOne #-}
1128−_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
1129−_takeOne n = composeN n $ S.take 1
1131−{-# INLINE takeAll #-}
1132−takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1133−takeAll value n = composeN n $ S.take (value + 1)
1135−{-# INLINE takeWhileTrue #-}
1136−takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1137−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
1139−{-# INLINE takeWhileMTrue #-}
1140−takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1141−takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
1143−{-# INLINE takeByTime #-}
1144−takeByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
1145−takeByTime i n = composeN n (Internal.takeByTime i)
1148−-- inspect $ hasNoType 'takeByTime ''SPEC
1149−inspect $ hasNoTypeClasses 'takeByTime
1150−-- inspect $ 'takeByTime `hasNoType` ''D.Step
1153−{-# INLINE dropOne #-}
1154−dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
1155−dropOne n = composeN n $ S.drop 1
1157−{-# INLINE dropAll #-}
1158−dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1159−dropAll value n = composeN n $ S.drop (value + 1)
1161−{-# INLINE dropWhileTrue #-}
1162−dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1163−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
1165−{-# INLINE dropWhileMTrue #-}
1166−dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1167−dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
1169−{-# INLINE dropWhileFalse #-}
1170−dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1171−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
1173−-- XXX Decide on the time interval
1174−{-# INLINE _intervalsOfSum #-}
1175−_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
1176−_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
1178−{-# INLINE dropByTime #-}
1179−dropByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
1180−dropByTime i n = composeN n (Internal.dropByTime i)
1183−inspect $ hasNoTypeClasses 'dropByTime
1184−-- inspect $ 'dropByTime `hasNoType` ''D.Step
1187−{-# INLINE findIndices #-}
1188−findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1189−findIndices value n = composeN n $ S.findIndices (== (value + 1))
1191−{-# INLINE elemIndices #-}
1192−elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1193−elemIndices value n = composeN n $ S.elemIndices (value + 1)
1195−{-# INLINE deleteBy #-}
1196−deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1197−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
1199−-- uniq . uniq == uniq, composeN 2 ~ composeN 1
1201−uniq :: MonadIO m => Int -> SerialT m Int -> m ()
1202−uniq n = composeN n S.uniq
1204−{-# INLINE mapMaybe #-}
1205−mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
1214−{-# INLINE mapMaybeM #-}
1215−mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
1221− then return Nothing
1222− else return $ Just x)
1224−o_1_space_filtering :: Int -> [Benchmark]
1225−o_1_space_filtering value =
1226− [ bgroup "filtering"
1227− [ benchIOSink value "filter-even" (filterEven 1)
1228− , benchIOSink value "filter-all-out" (filterAllOut value 1)
1229− , benchIOSink value "filter-all-in" (filterAllIn value 1)
1231− , benchIOSink value "filterM-even" (filterMEven 1)
1232− , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
1233− , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
1236− , benchIOSink value "take-all" (takeAll value 1)
1240− (takeByTime (NanoSecond64 maxBound) 1)
1241− , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
1242− -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
1243− , benchIOSink value "drop-one" (dropOne 1)
1244− , benchIOSink value "drop-all" (dropAll value 1)
1248− (dropByTime (NanoSecond64 maxBound) 1)
1249− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
1250− -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
1254− (dropWhileFalse value 1)
1255− , benchIOSink value "deleteBy" (deleteBy value 1)
1257− , benchIOSink value "uniq" (uniq 1)
1260− , benchIOSink value "mapMaybe" (mapMaybe 1)
1261− , benchIOSink value "mapMaybeM" (mapMaybeM 1)
1263− -- Searching (stateful map and filter)
1264− , benchIOSink value "findIndices" (findIndices value 1)
1265− , benchIOSink value "elemIndices" (elemIndices value 1)
1269−o_1_space_filteringX4 :: Int -> [Benchmark]
1270−o_1_space_filteringX4 value =
1271− [ bgroup "filteringX4"
1272− [ benchIOSink value "filter-even" (filterEven 4)
1273− , benchIOSink value "filter-all-out" (filterAllOut value 4)
1274− , benchIOSink value "filter-all-in" (filterAllIn value 4)
1276− , benchIOSink value "filterM-even" (filterMEven 4)
1277− , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
1278− , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
1281− , benchIOSink value "take-all" (takeAll value 4)
1282− , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
1283− , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)
1284− , benchIOSink value "drop-one" (dropOne 4)
1285− , benchIOSink value "drop-all" (dropAll value 4)
1286− , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
1287− , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)
1291− (dropWhileFalse value 4)
1292− , benchIOSink value "deleteBy" (deleteBy value 4)
1294− , benchIOSink value "uniq" (uniq 4)
1297− , benchIOSink value "mapMaybe" (mapMaybe 4)
1298− , benchIOSink value "mapMaybeM" (mapMaybeM 4)
1301− , benchIOSink value "findIndices" (findIndices value 4)
1302− , benchIOSink value "elemIndices" (elemIndices value 4)
1306−-------------------------------------------------------------------------------
1307−-- Grouping transformations
1308−-------------------------------------------------------------------------------
1310−{-# INLINE groups #-}
1311−groups :: MonadIO m => SerialT m Int -> m ()
1312−groups = S.drain . S.groups FL.drain
1314−-- XXX Change this test when the order of comparison is later changed
1315−{-# INLINE groupsByGT #-}
1316−groupsByGT :: MonadIO m => SerialT m Int -> m ()
1317−groupsByGT = S.drain . S.groupsBy (>) FL.drain
1319−{-# INLINE groupsByEq #-}
1320−groupsByEq :: MonadIO m => SerialT m Int -> m ()
1321−groupsByEq = S.drain . S.groupsBy (==) FL.drain
1323−{-# INLINE groupsByRollingLT #-}
1324−groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
1326− S.drain . S.groupsByRolling (<) FL.drain
1328−{-# INLINE groupsByRollingEq #-}
1329−groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
1331− S.drain . S.groupsByRolling (==) FL.drain
1333−o_1_space_grouping :: Int -> [Benchmark]
1334−o_1_space_grouping value =
1335− [ bgroup "grouping"
1336− [ benchIOSink value "groups" groups
1337− , benchIOSink value "groupsByGT" groupsByGT
1338− , benchIOSink value "groupsByEq" groupsByEq
1339− , benchIOSink value "groupsByRollingLT" groupsByRollingLT
1340− , benchIOSink value "groupsByRollingEq" groupsByRollingEq
1344−-------------------------------------------------------------------------------
1345−-- Size increasing transformations (insertions)
1346−-------------------------------------------------------------------------------
1348−{-# INLINE intersperse #-}
1349−intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
1350−intersperse value n = composeN n $ S.intersperse (value + 1)
1352−{-# INLINE intersperseM #-}
1353−intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
1354−intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
1356−{-# INLINE insertBy #-}
1357−insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1358−insertBy value n = composeN n $ S.insertBy compare (value + 1)
1360−o_1_space_inserting :: Int -> [Benchmark]
1361−o_1_space_inserting value =
1362− [ bgroup "filtering"
1363− [ benchIOSink value "intersperse" (intersperse value 1)
1364− , benchIOSink value "intersperseM" (intersperseM value 1)
1365− , benchIOSink value "insertBy" (insertBy value 1)
1369−o_1_space_insertingX4 :: Int -> [Benchmark]
1370−o_1_space_insertingX4 value =
1371− [ bgroup "insertingX4"
1372− [ benchIOSink value "intersperse" (intersperse value 4)
1373− , benchIOSink value "insertBy" (insertBy value 4)
1377−-------------------------------------------------------------------------------
1379−-------------------------------------------------------------------------------
1381−{-# INLINE indexed #-}
1382−indexed :: MonadIO m => Int -> SerialT m Int -> m ()
1383−indexed n = composeN n (S.map snd . S.indexed)
1385−{-# INLINE indexedR #-}
1386−indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1387−indexedR value n = composeN n (S.map snd . S.indexedR value)
1389−o_1_space_indexing :: Int -> [Benchmark]
1390−o_1_space_indexing value =
1391− [ bgroup "indexing"
1392− [ benchIOSink value "indexed" (indexed 1)
1393− , benchIOSink value "indexedR" (indexedR value 1)
1397−o_1_space_indexingX4 :: Int -> [Benchmark]
1398−o_1_space_indexingX4 value =
1399− [ bgroup "indexingx4"
1400− [ benchIOSink value "indexed" (indexed 4)
1401− , benchIOSink value "indexedR" (indexedR value 4)
1405−-------------------------------------------------------------------------------
1406−-- Size conserving transformations (reordering, buffering, etc.)
1407−-------------------------------------------------------------------------------
1409−{-# INLINE reverse #-}
1410−reverse :: MonadIO m => Int -> SerialT m Int -> m ()
1411−reverse n = composeN n S.reverse
1413−{-# INLINE reverse' #-}
1414−reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
1415−reverse' n = composeN n Internal.reverse'
1417−o_n_heap_buffering :: Int -> [Benchmark]
1418−o_n_heap_buffering value =
1419− [ bgroup "buffered"
1421− -- Reversing/sorting a stream
1422− benchIOSink value "reverse" (reverse 1)
1423− , benchIOSink value "reverse'" (reverse' 1)
1425− , benchIOSink value "mkAsync" (mkAsync serially)
1429−-------------------------------------------------------------------------------
1430−-- Grouping/Splitting
1431−-------------------------------------------------------------------------------
1433−{-# INLINE classifySessionsOf #-}
1434−classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()
1435−classifySessionsOf =
1437− . Internal.classifySessionsOf
1438− 3 (const (return False)) (P.fmap Right FL.drain)
1439− . S.map (\(ts,(k,a)) -> (k, a, ts))
1440− . Internal.timestamped
1441− . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
1443−o_n_space_grouping :: Int -> [Benchmark]
1444−o_n_space_grouping value =
1445− -- Buffering operations using heap proportional to group/window sizes.
1446− [ bgroup "grouping"
1447− [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf
1451−-------------------------------------------------------------------------------
1452−-- Mixed Transformation
1453−-------------------------------------------------------------------------------
1455−{-# INLINE scanMap #-}
1456−scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
1457−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
1459−{-# INLINE dropMap #-}
1460−dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
1461−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
1463−{-# INLINE dropScan #-}
1464−dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
1465−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
1467−{-# INLINE takeDrop #-}
1468−takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1469−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
1471−{-# INLINE takeScan #-}
1472−takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1473−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
1475−{-# INLINE takeMap #-}
1476−takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1477−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
1479−{-# INLINE filterDrop #-}
1480−filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1481−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
1483−{-# INLINE filterTake #-}
1484−filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1485−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
1487−{-# INLINE filterScan #-}
1488−filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
1489−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
1491−{-# INLINE filterScanl1 #-}
1492−filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
1493−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
1495−{-# INLINE filterMap #-}
1496−filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1497−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
1499−-------------------------------------------------------------------------------
1501−-------------------------------------------------------------------------------
1505− deriving (Generic, NFData)
1507−{-# INLINE sumProductFold #-}
1508−sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
1509−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p P.* x)) (0, 1)
1511−{-# INLINE sumProductScan #-}
1512−sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
1514− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p P.* x)) (Pair 0 1) .
1515− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
1517−{-# INLINE foldl'ReduceMap #-}
1518−foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
1519−foldl'ReduceMap = P.fmap (+ 1) . S.foldl' (+) 0
1521−o_1_space_transformations_mixed :: Int -> [Benchmark]
1522−o_1_space_transformations_mixed value =
1523− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
1524− -- library. If scan/fold followed by a map is efficient enough we may not
1525− -- need monolithic implementations of these.
1527− [ benchIOSink value "scanl-map" (scanMap 1)
1528− , benchIOSink value "foldl-map" foldl'ReduceMap
1529− , benchIOSink value "sum-product-fold" sumProductFold
1530− , benchIOSink value "sum-product-scan" sumProductScan
1534−o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
1535−o_1_space_transformations_mixedX4 value =
1537− [ benchIOSink value "scan-map" (scanMap 4)
1538− , benchIOSink value "drop-map" (dropMap 4)
1539− , benchIOSink value "drop-scan" (dropScan 4)
1540− , benchIOSink value "take-drop" (takeDrop value 4)
1541− , benchIOSink value "take-scan" (takeScan value 4)
1542− , benchIOSink value "take-map" (takeMap value 4)
1543− , benchIOSink value "filter-drop" (filterDrop value 4)
1544− , benchIOSink value "filter-take" (filterTake value 4)
1545− , benchIOSink value "filter-scan" (filterScan 4)
1546− , benchIOSink value "filter-scanl1" (filterScanl1 4)
1547− , benchIOSink value "filter-map" (filterMap value 4)
1551−-------------------------------------------------------------------------------
1552−-- Iterating a transformation over and over again
1553−-------------------------------------------------------------------------------
1555−-- this is quadratic
1556−{-# INLINE iterateScan #-}
1557−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
1558−iterateScan = iterateSource (S.scanl' (+) 0)
1560−-- this is quadratic
1561−{-# INLINE iterateScanl1 #-}
1562−iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
1563−iterateScanl1 = iterateSource (S.scanl1' (+))
1565−{-# INLINE iterateMapM #-}
1566−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
1567−iterateMapM = iterateSource (S.mapM return)
1569−{-# INLINE iterateFilterEven #-}
1570−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
1571−iterateFilterEven = iterateSource (S.filter even)
1573−{-# INLINE iterateTakeAll #-}
1574−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
1575−iterateTakeAll value = iterateSource (S.take (value + 1))
1577−{-# INLINE iterateDropOne #-}
1578−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
1579−iterateDropOne = iterateSource (S.drop 1)
1581−{-# INLINE iterateDropWhileFalse #-}
1582−iterateDropWhileFalse :: S.MonadAsync m
1583− => Int -> Int -> Int -> Int -> SerialT m Int
1584−iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
1586−{-# INLINE iterateDropWhileTrue #-}
1587−iterateDropWhileTrue :: S.MonadAsync m
1588− => Int -> Int -> Int -> Int -> SerialT m Int
1589−iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
1592−tail :: Monad m => SerialT m a -> m ()
1593−tail s = S.tail s >>= P.mapM_ tail
1595−{-# INLINE nullHeadTail #-}
1596−nullHeadTail :: Monad m => SerialT m Int -> m ()
1601− S.tail s >>= P.mapM_ nullHeadTail
1603−-- Head recursive operations.
1604−o_n_stack_iterated :: Int -> [Benchmark]
1605−o_n_stack_iterated value = by10 `seq` by100 `seq`
1606− [ bgroup "iterated"
1607− [ benchIOSrc serially "mapM (n/10 x 10)" $ iterateMapM by10 10
1608− , benchIOSrc serially "scanl' (quadratic) (n/100 x 100)" $
1609− iterateScan by100 100
1610− , benchIOSrc serially "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
1611− , benchIOSrc serially "filterEven (n/10 x 10)" $
1612− iterateFilterEven by10 10
1613− , benchIOSrc serially "takeAll (n/10 x 10)" $
1614− iterateTakeAll value by10 10
1615− , benchIOSrc serially "dropOne (n/10 x 10)" $ iterateDropOne by10 10
1616− , benchIOSrc serially "dropWhileFalse (n/10 x 10)" $
1617− iterateDropWhileFalse value by10 10
1618− , benchIOSrc serially "dropWhileTrue (n/10 x 10)" $
1619− iterateDropWhileTrue value by10 10
1620− , benchIOSink value "tail" tail
1621− , benchIOSink value "nullHeadTail" nullHeadTail
1627− by10 = value `div` 10
1628− by100 = value `div` 100
1630−-------------------------------------------------------------------------------
1632−-------------------------------------------------------------------------------
1634−o_1_space_pipes :: Int -> [Benchmark]
1635−o_1_space_pipes value =
1637− [ benchIOSink value "mapM" (transformMapM serially 1)
1638− , benchIOSink value "compose" (transformComposeMapM serially 1)
1639− , benchIOSink value "tee" (transformTeeMapM serially 1)
1640− , benchIOSink value "zip" (transformZipMapM serially 1)
1644−o_1_space_pipesX4 :: Int -> [Benchmark]
1645−o_1_space_pipesX4 value =
1647− [ benchIOSink value "mapM" (transformMapM serially 4)
1648− , benchIOSink value "compose" (transformComposeMapM serially 4)
1649− , benchIOSink value "tee" (transformTeeMapM serially 4)
1650− , benchIOSink value "zip" (transformZipMapM serially 4)
1654−-------------------------------------------------------------------------------
1656−-------------------------------------------------------------------------------
1658−-------------------------------------------------------------------------------
1660−-------------------------------------------------------------------------------
1662−{-# INLINE serial2 #-}
1663−serial2 :: Int -> Int -> IO ()
1666− S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
1668−{-# INLINE serial4 #-}
1669−serial4 :: Int -> Int -> IO ()
1673− (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
1675− (sourceUnfoldrM count (n + 2))
1676− (sourceUnfoldrM count (n + 3)))
1678−{-# INLINE append2 #-}
1679−append2 :: Int -> Int -> IO ()
1682− Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
1684−{-# INLINE append4 #-}
1685−append4 :: Int -> Int -> IO ()
1690− (sourceUnfoldrM count n)
1691− (sourceUnfoldrM count (n + 1)))
1693− (sourceUnfoldrM count (n + 2))
1694− (sourceUnfoldrM count (n + 3)))
1697−inspect $ hasNoTypeClasses 'append2
1698−inspect $ 'append2 `hasNoType` ''SPEC
1699−inspect $ 'append2 `hasNoType` ''D.AppendState
1702−-------------------------------------------------------------------------------
1704−-------------------------------------------------------------------------------
1706−{-# INLINE mergeBy #-}
1707−mergeBy :: Int -> Int -> IO ()
1712− (sourceUnfoldrM count n)
1713− (sourceUnfoldrM count (n + 1))
1715−{-# INLINE mergeByM #-}
1716−mergeByM :: Int -> Int -> IO ()
1720− (\a b -> return $ P.compare a b)
1721− (sourceUnfoldrM count n)
1722− (sourceUnfoldrM count (n + 1))
1725−inspect $ hasNoTypeClasses 'mergeBy
1726−inspect $ 'mergeBy `hasNoType` ''SPEC
1727−inspect $ 'mergeBy `hasNoType` ''D.Step
1729−inspect $ hasNoTypeClasses 'mergeByM
1730−inspect $ 'mergeByM `hasNoType` ''SPEC
1731−inspect $ 'mergeByM `hasNoType` ''D.Step
1734−o_1_space_joining :: Int -> [Benchmark]
1735−o_1_space_joining value =
1737− [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
1738− , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
1739− , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
1740− , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
1741− , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
1742− , benchIOSrc1 "mergeByM (2,x/2)" (mergeByM (value `div` 2))
1746−-------------------------------------------------------------------------------
1747−-- Concat Foldable containers
1748−-------------------------------------------------------------------------------
1750−o_1_space_concatFoldable :: Int -> [Benchmark]
1751−o_1_space_concatFoldable value =
1752− [ bgroup "concat-foldable"
1753− [ benchIOSrc serially "foldMapWith (<>) (List)"
1754− (sourceFoldMapWith value)
1755− , benchIOSrc serially "foldMapWith (<>) (Stream)"
1756− (sourceFoldMapWithStream value)
1757− , benchIOSrc serially "foldMapWithM (<>) (List)"
1758− (sourceFoldMapWithM value)
1759− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
1760− (concatFoldableWith value)
1761− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
1762− (concatForFoldableWith value)
1763− , benchIOSrc serially "foldMapM (List)" (sourceFoldMapM value)
1767−-------------------------------------------------------------------------------
1769−-------------------------------------------------------------------------------
1771−-- concatMap unfoldrM/unfoldrM
1773−{-# INLINE concatMap #-}
1774−concatMap :: Int -> Int -> Int -> IO ()
1775−concatMap outer inner n =
1776− S.drain $ S.concatMap
1777− (\_ -> sourceUnfoldrM inner n)
1778− (sourceUnfoldrM outer n)
1780−{-# INLINE concatMapM #-}
1781−concatMapM :: Int -> Int -> Int -> IO ()
1782−concatMapM outer inner n =
1783− S.drain $ S.concatMapM
1784− (\_ -> return $ sourceUnfoldrM inner n)
1785− (sourceUnfoldrM outer n)
1788−inspect $ hasNoTypeClasses 'concatMap
1789−inspect $ 'concatMap `hasNoType` ''SPEC
1792−-- concatMap unfoldr/unfoldr
1794−{-# INLINE concatMapPure #-}
1795−concatMapPure :: Int -> Int -> Int -> IO ()
1796−concatMapPure outer inner n =
1797− S.drain $ S.concatMap
1798− (\_ -> sourceUnfoldr inner n)
1799− (sourceUnfoldr outer n)
1802−inspect $ hasNoTypeClasses 'concatMapPure
1803−inspect $ 'concatMapPure `hasNoType` ''SPEC
1806−-- concatMap replicate/unfoldrM
1808−{-# INLINE concatMapRepl #-}
1809−concatMapRepl :: Int -> Int -> Int -> IO ()
1810−concatMapRepl outer inner n =
1811− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
1814−inspect $ hasNoTypeClasses 'concatMapRepl
1815−inspect $ 'concatMapRepl `hasNoType` ''SPEC
1820−{-# INLINE concatMapWithSerial #-}
1821−concatMapWithSerial :: Int -> Int -> Int -> IO ()
1822−concatMapWithSerial = concatStreamsWith S.serial
1825−inspect $ hasNoTypeClasses 'concatMapWithSerial
1826−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1829−{-# INLINE concatMapWithAppend #-}
1830−concatMapWithAppend :: Int -> Int -> Int -> IO ()
1831−concatMapWithAppend = concatStreamsWith Internal.append
1834−inspect $ hasNoTypeClasses 'concatMapWithAppend
1835−inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
1840−-- concatUnfold replicate/unfoldrM
1842−{-# INLINE concatUnfoldRepl #-}
1843−concatUnfoldRepl :: Int -> Int -> Int -> IO ()
1844−concatUnfoldRepl outer inner n =
1847− (UF.lmap return (UF.replicateM inner))
1848− (sourceUnfoldrM outer n)
1851−inspect $ hasNoTypeClasses 'concatUnfoldRepl
1852−inspect $ 'concatUnfoldRepl `hasNoType` ''D.ConcatMapUState
1853−inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
1856−o_1_space_concat :: Int -> [Benchmark]
1857−o_1_space_concat value = sqrtVal `seq`
1859− [ benchIOSrc1 "concatMapPure (n of 1)"
1860− (concatMapPure value 1)
1861− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
1862− (concatMapPure sqrtVal sqrtVal)
1863− , benchIOSrc1 "concatMapPure (1 of n)"
1864− (concatMapPure 1 value)
1866− -- This is for comparison with foldMapWith
1867− , benchIOSrc serially "concatMapId (n of 1) (fromFoldable)"
1868− (S.concatMap id . sourceConcatMapId value)
1870− , benchIOSrc1 "concatMap (n of 1)"
1871− (concatMap value 1)
1872− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
1873− (concatMap sqrtVal sqrtVal)
1874− , benchIOSrc1 "concatMap (1 of n)"
1875− (concatMap 1 value)
1877− , benchIOSrc1 "concatMapM (n of 1)"
1878− (concatMapM value 1)
1879− , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
1880− (concatMapM sqrtVal sqrtVal)
1881− , benchIOSrc1 "concatMapM (1 of n)"
1882− (concatMapM 1 value)
1884− -- This is for comparison with foldMapWith
1885− , benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
1886− (S.concatMapWith serial id . sourceConcatMapId value)
1888− , benchIOSrc1 "concatMapWith (n of 1)"
1889− (concatMapWithSerial value 1)
1890− , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
1891− (concatMapWithSerial sqrtVal sqrtVal)
1892− , benchIOSrc1 "concatMapWith (1 of n)"
1893− (concatMapWithSerial 1 value)
1895− -- quadratic with number of outer streams
1896− , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
1897− (concatMapWithAppend 2 (value `div` 2))
1899− -- concatMap vs concatUnfold
1900− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
1901− (concatMapRepl sqrtVal sqrtVal)
1902− , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
1903− (concatUnfoldRepl sqrtVal sqrtVal)
1909− sqrtVal = round $ sqrt (fromIntegral value :: Double)
1911−-------------------------------------------------------------------------------
1913−-------------------------------------------------------------------------------
1915−o_1_space_applicative :: Int -> [Benchmark]
1916−o_1_space_applicative value =
1917− [ bgroup "Applicative"
1918− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value serially
1919− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value serially
1920− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value serially
1921− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value serially
1925−o_n_space_applicative :: Int -> [Benchmark]
1926−o_n_space_applicative value =
1927− [ bgroup "Applicative"
1928− [ benchIOSrc serially "(*>) (n times)" $
1929− iterateSingleton ((*>) . pure) value
1930− , benchIOSrc serially "(<*) (n times)" $
1931− iterateSingleton (\x xs -> xs <* pure x) value
1932− , benchIOSrc serially "(<*>) (n times)" $
1933− iterateSingleton (\x xs -> (P.fmap (+) (pure x) <*> xs)) value
1934− , benchIOSrc serially "liftA2 (n times)" $
1935− iterateSingleton (\x xs -> AP.liftA2 (+) (pure x) xs) value
1939−-------------------------------------------------------------------------------
1941−-------------------------------------------------------------------------------
1943−o_1_space_monad :: Int -> [Benchmark]
1944−o_1_space_monad value =
1946− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value serially
1947− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value serially
1948− , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
1949− filterAllOutM value serially
1950− , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
1951− filterAllInM value serially
1952− , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
1953− filterSome value serially
1954− , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
1955− breakAfterSome value serially
1956− , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
1957− toNullM3 value serially
1961−-- This is a good benchmark but inefficient way to compute primes. As we see a
1962−-- new prime we keep appending a division filter for all the future numbers.
1963−{-# INLINE sieve #-}
1964−sieve :: Monad m => SerialT m Int -> SerialT m Int
1966− r <- lift $ S.uncons s
1968− Just (prime, rest) ->
1969− prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest)
1972−o_n_space_monad :: Int -> [Benchmark]
1973−o_n_space_monad value =
1975− [ benchIOSrc serially "(>>) (n times)" $
1976− iterateSingleton ((>>) . pure) value
1977− , benchIOSrc serially "(>>=) (n times)" $
1978− iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
1979− , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
1980− toListM value serially
1981− , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
1982− toListSome value serially
1983− , benchIO "naive prime sieve (n/4)"
1984− (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
1988−-------------------------------------------------------------------------------
1989−-- Monad transformation (hoisting etc.)
1990−-------------------------------------------------------------------------------
1992−{-# INLINE sourceUnfoldrState #-}
1993−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
1994− => Int -> Int -> t (StateT Int m) Int
1995−sourceUnfoldrState value n = S.unfoldrM step n
1999− then return Nothing
2003− return (Just (s, cnt + 1))
2005−{-# INLINE evalStateT #-}
2006−evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
2007−evalStateT value n =
2008− Internal.evalStateT (return 0) (sourceUnfoldrState value n)
2010−{-# INLINE withState #-}
2011−withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
2013− Internal.evalStateT
2014− (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
2016−o_1_space_hoisting :: Int -> [Benchmark]
2017−o_1_space_hoisting value =
2018− [ bgroup "hoisting"
2019− [ benchIOSrc serially "evalState" (evalStateT value)
2020− , benchIOSrc serially "withState" (withState value)
2024−{-# INLINE iterateStateIO #-}
2028− -> StateT Int m Int
2029−iterateStateIO n = do
2037−{-# INLINE iterateStateT #-}
2038−iterateStateT :: Int -> SerialT (StateT Int IO) Int
2039−iterateStateT n = do
2047−{-# INLINE iterateState #-}
2049− (S.MonadAsync m, MonadState Int m)
2060−o_n_heap_transformer :: Int -> [Benchmark]
2061−o_n_heap_transformer value =
2062− [ bgroup "transformer"
2063− [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
2064− State.evalStateT (iterateStateIO n) value
2065− , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
2066− State.evalStateT (S.drain (iterateStateT n)) value
2067− , benchIO "MonadState Int m => SerialT m Int" $ \n ->
2068− State.evalStateT (S.drain (iterateState n)) value
2073-------------------------------------------------------------------------------
27-------------------------------------------------------------------------------
2075-------------------------------------------------------------------------------
29-------------------------------------------------------------------------------
@@ -2084,71 +38,11 @@ main = do
2087− allBenchmarks size =
41+ allBenchmarks size = Prelude.concat
2088− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
42+ [ Generation.benchmarks moduleName size
2089− [ o_1_space_generation size
43+ , Elimination.benchmarks moduleName size
2090−
44+ , Transformation1.benchmarks moduleName size
2091− -- elimination
45+ , Transformation2.benchmarks moduleName size
2092− , o_1_space_elimination_foldable size
46+ , Transformation3.benchmarks moduleName size
2093− , o_1_space_elimination_folds size
47+ , Nested.benchmarks moduleName size
2094− , o_1_space_elimination_multi_stream_pure size
2095− , o_1_space_elimination_multi_stream size
2098− , o_1_space_functor size
2099− , o_1_space_mapping size
2100− , o_1_space_mappingX4 size
2101− , o_1_space_filtering size
2102− , o_1_space_filteringX4 size
2103− , o_1_space_inserting size
2104− , o_1_space_insertingX4 size
2105− , o_1_space_transformations_mixed size
2106− , o_1_space_transformations_mixedX4 size
2107− , o_1_space_indexing size
2108− , o_1_space_indexingX4 size
2111− , o_1_space_grouping size
2114− , o_1_space_pipes size
2115− , o_1_space_pipesX4 size
2118− , o_1_space_joining size
2119− , o_1_space_concatFoldable size
2120− , o_1_space_concat size
2122− , o_1_space_applicative size
2123− , o_1_space_monad size
2125− -- Monad transformation
2126− , o_1_space_hoisting size
2128− , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
2129− , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
2130− [ o_n_heap_generation size
2131− , o_n_heap_elimination_foldl size
2132− , o_n_heap_elimination_toList size
2133− , o_n_heap_elimination_buffered size
2136− , o_n_heap_buffering size
2137− , o_n_heap_transformer size
2139− , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
2140− [ o_n_space_elimination_foldable size
2141− , o_n_space_elimination_toList size
2142− , o_n_space_elimination_foldr size
2145− , o_n_space_traversable size
2146− , o_n_space_mapping size
2147− , o_n_space_grouping size
2150− , o_n_space_functor size
2151− , o_n_space_applicative size
2152− , o_n_space_monad size