git.iko.soy/streamly
on master help sign in
Reorganize prelude benchmarks
76c3f2bHarendra Kumar
benchmark/Streamly/Benchmark/Prelude.hs+254−198
compare with master
unifiedsplit
@@ -61,19 +61,13 @@ value = 100000
61maxValue = value + 1
61maxValue = value + 1
62value2 = P.round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
62value2 = P.round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
63
63
64−-------------------------------------------------------------------------------
64+type Stream m a = S.SerialT m a
65−-- Benchmark ops
66−-------------------------------------------------------------------------------
67
65
68-------------------------------------------------------------------------------
66-------------------------------------------------------------------------------
69−-- Stream generation and elimination
67+-- Stream generation
70-------------------------------------------------------------------------------
68-------------------------------------------------------------------------------
71
69
72−type Stream m a = S.SerialT m a
70+-- enumerate
73−
74−{-# INLINE source #-}
75−source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
76−source n = sourceUnfoldrM n
77
71
78{-# INLINE sourceIntFromTo #-}
72{-# INLINE sourceIntFromTo #-}
79sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> t m Int
73sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> t m Int
@@ -98,50 +92,7 @@ sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> t m Integer
98sourceIntegerFromStep n =
92sourceIntegerFromStep n =
99 S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
93 S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
100
94
101−{-# INLINE sourceFromList #-}
95+-- unfoldr
102−sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int
103−sourceFromList n = S.fromList [n..n+value]
104−
105−{-# INLINE sourceFromListM #-}
106−sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
107−sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])
108−
109−{-# INLINE sourceFromIndices #-}
110−sourceFromIndices :: (Monad m, S.IsStream t) => Int -> t m Int
111−sourceFromIndices n = S.take value $ S.fromIndices (+ n)
112−
113−{-# INLINE sourceFromIndicesM #-}
114−sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
115−sourceFromIndicesM n = S.take value $ S.fromIndicesM (Prelude.fmap return (+ n))
116−
117−{-# INLINE sourceFromFoldable #-}
118−sourceFromFoldable :: S.IsStream t => Int -> t m Int
119−sourceFromFoldable n = S.fromFoldable [n..n+value]
120−
121−{-# INLINE sourceFromFoldableM #-}
122−sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
123−sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
124−
125−{-# INLINE sourceFoldMapWith #-}
126−sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
127− => Int -> t m Int
128−sourceFoldMapWith n = S.foldMapWith (S.<>) S.yield [n..n+value]
129−
130−{-# INLINE sourceFoldMapWithM #-}
131−sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
132− => Int -> t m Int
133−sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
134−
135−{-# INLINE sourceFoldMapM #-}
136−sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))
137− => Int -> t m Int
138−sourceFoldMapM n = F.foldMap (S.yieldM . return) [n..n+value]
139−
140−{-# INLINE sourceConcatMapId #-}
141−sourceConcatMapId :: (S.IsStream t, Monad m)
142− => Int -> t m Int
143−sourceConcatMapId n =
144− S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]
145
96
146{-# INLINE sourceUnfoldr #-}
97{-# INLINE sourceUnfoldr #-}
147sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int
98sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int
@@ -170,18 +121,9 @@ sourceUnfoldrM n = S.unfoldrM step n
170 then return Nothing
121 then return Nothing
171 else return (Just (cnt, cnt + 1))
122 else return (Just (cnt, cnt + 1))
172
123
173−{-# INLINE sourceUnfoldrState #-}
124+{-# INLINE source #-}
174−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
125+source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
175− => Int -> t (StateT Int m) Int
126+source n = sourceUnfoldrM n
176−sourceUnfoldrState n = S.unfoldrM step n
177− where
178− step cnt =
179− if cnt > n + value
180− then return Nothing
181− else do
182− s <- get
183− put (s + 1)
184− return (Just (s, cnt + 1))
185
127
186{-# INLINE sourceUnfoldrMN #-}
128{-# INLINE sourceUnfoldrMN #-}
187sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
129sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
@@ -201,9 +143,25 @@ sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n
201 then return Nothing
143 then return Nothing
202 else return (Just (return cnt, cnt + 1))
144 else return (Just (return cnt, cnt + 1))
203
145
204−-------------------------------------------------------------------------------
146+-- fromIndices
205−-- Pure stream generation
147+
206−-------------------------------------------------------------------------------
148+{-# INLINE sourceFromIndices #-}
149+sourceFromIndices :: (Monad m, S.IsStream t) => Int -> t m Int
150+sourceFromIndices n = S.take value $ S.fromIndices (+ n)
151+
152+{-# INLINE sourceFromIndicesM #-}
153+sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
154+sourceFromIndicesM n = S.take value $ S.fromIndicesM (Prelude.fmap return (+ n))
155+
156+-- fromList
157+
158+{-# INLINE sourceFromList #-}
159+sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int
160+sourceFromList n = S.fromList [n..n+value]
161+
162+{-# INLINE sourceFromListM #-}
163+sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
164+sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])
207
165
208{-# INLINE sourceIsList #-}
166{-# INLINE sourceIsList #-}
209sourceIsList :: Int -> S.SerialT Identity Int
167sourceIsList :: Int -> S.SerialT Identity Int
@@ -213,6 +171,16 @@ sourceIsList n = GHC.fromList [n..n+value]
213sourceIsString :: Int -> S.SerialT Identity P.Char
171sourceIsString :: Int -> S.SerialT Identity P.Char
214sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
172sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
215
173
174+-- fromFoldable
175+
176+{-# INLINE sourceFromFoldable #-}
177+sourceFromFoldable :: S.IsStream t => Int -> t m Int
178+sourceFromFoldable n = S.fromFoldable [n..n+value]
179+
180+{-# INLINE sourceFromFoldableM #-}
181+sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
182+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
183+
216-------------------------------------------------------------------------------
184-------------------------------------------------------------------------------
217-- Elimination
185-- Elimination
218-------------------------------------------------------------------------------
186-------------------------------------------------------------------------------
@@ -224,15 +192,6 @@ runStream = S.drain
224{-# INLINE toList #-}
192{-# INLINE toList #-}
225toList :: Monad m => Stream m Int -> m [Int]
193toList :: Monad m => Stream m Int -> m [Int]
226
194
227−{-# INLINE evalStateT #-}
228−evalStateT :: S.MonadAsync m => Int -> Stream m Int
229−evalStateT n = Internal.evalStateT 0 (sourceUnfoldrState n)
230−
231−{-# INLINE withState #-}
232−withState :: S.MonadAsync m => Int -> Stream m Int
233−withState n =
234− Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM n))
235−
236{-# INLINE head #-}
195{-# INLINE head #-}
237{-# INLINE last #-}
196{-# INLINE last #-}
238{-# INLINE maximum #-}
197{-# INLINE maximum #-}
@@ -448,26 +407,6 @@ tapAsyncS n = composeN n $ Par.tapAsync S.sum
448tapAsync :: S.MonadAsync m => Int -> Stream m Int -> m ()
407tapAsync :: S.MonadAsync m => Int -> Stream m Int -> m ()
449tapAsync n = composeN n $ Internal.tapAsync FL.sum
408tapAsync n = composeN n $ Internal.tapAsync FL.sum
450
409
451−{-# INLINE transformMapM #-}
452−{-# INLINE transformComposeMapM #-}
453−{-# INLINE transformTeeMapM #-}
454−{-# INLINE transformZipMapM #-}
455−
456−transformMapM, transformComposeMapM, transformTeeMapM,
457− transformZipMapM :: (S.IsStream t, S.MonadAsync m)
458− => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
459−
460−transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)
461−transformComposeMapM t n = composeN' n $ t . Internal.transform
462− (Pipe.mapM (\x -> return (x + 1))
463− `Pipe.compose` Pipe.mapM (\x -> return (x + 2)))
464−transformTeeMapM t n = composeN' n $ t . Internal.transform
465− (Pipe.mapM (\x -> return (x + 1))
466− `Pipe.tee` Pipe.mapM (\x -> return (x + 2)))
467−transformZipMapM t n = composeN' n $ t . Internal.transform
468− (Pipe.zipWith (+) (Pipe.mapM (\x -> return (x + 1)))
469− (Pipe.mapM (\x -> return (x + 2))))
470−
471mapMaybe n = composeN n $ S.mapMaybe
410mapMaybe n = composeN n $ S.mapMaybe
472 (\x -> if Prelude.odd x then Nothing else Just x)
411 (\x -> if Prelude.odd x then Nothing else Just x)
473mapMaybeM n = composeN n $ S.mapMaybeM
412mapMaybeM n = composeN n $ S.mapMaybeM
@@ -497,6 +436,76 @@ foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.n
497foldrT n = composeN n $ Internal.foldrT S.cons S.nil
436foldrT n = composeN n $ Internal.foldrT S.cons S.nil
498foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
437foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
499
438
439+-------------------------------------------------------------------------------
440+-- Pipes
441+-------------------------------------------------------------------------------
442+
443+{-# INLINE transformMapM #-}
444+{-# INLINE transformComposeMapM #-}
445+{-# INLINE transformTeeMapM #-}
446+{-# INLINE transformZipMapM #-}
447+
448+transformMapM, transformComposeMapM, transformTeeMapM,
449+ transformZipMapM :: (S.IsStream t, S.MonadAsync m)
450+ => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
451+
452+transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)
453+transformComposeMapM t n = composeN' n $ t . Internal.transform
454+ (Pipe.mapM (\x -> return (x + 1))
455+ `Pipe.compose` Pipe.mapM (\x -> return (x + 2)))
456+transformTeeMapM t n = composeN' n $ t . Internal.transform
457+ (Pipe.mapM (\x -> return (x + 1))
458+ `Pipe.tee` Pipe.mapM (\x -> return (x + 2)))
459+transformZipMapM t n = composeN' n $ t . Internal.transform
460+ (Pipe.zipWith (+) (Pipe.mapM (\x -> return (x + 1)))
461+ (Pipe.mapM (\x -> return (x + 2))))
462+
463+-------------------------------------------------------------------------------
464+-- Mixed Transformation
465+-------------------------------------------------------------------------------
466+
467+{-# INLINE scanMap #-}
468+{-# INLINE dropMap #-}
469+{-# INLINE dropScan #-}
470+{-# INLINE takeDrop #-}
471+{-# INLINE takeScan #-}
472+{-# INLINE takeMap #-}
473+{-# INLINE filterDrop #-}
474+{-# INLINE filterTake #-}
475+{-# INLINE filterScan #-}
476+{-# INLINE filterScanl1 #-}
477+{-# INLINE filterMap #-}
478+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
479+ filterTake, filterScan, filterScanl1, filterMap
480+ :: MonadIO m => Int -> Stream m Int -> m ()
481+
482+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
483+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
484+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
485+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
486+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
487+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
488+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
489+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
490+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
491+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
492+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
493+
494+-------------------------------------------------------------------------------
495+-- Scan and fold
496+-------------------------------------------------------------------------------
497+
498+data Pair a b = Pair !a !b deriving (Generic, NFData)
499+
500+{-# INLINE sumProductFold #-}
501+sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
502+sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
503+
504+{-# INLINE sumProductScan #-}
505+sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
506+sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
507+ . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
508+
500-------------------------------------------------------------------------------
509-------------------------------------------------------------------------------
501-- Iteration
510-- Iteration
502-------------------------------------------------------------------------------
511-------------------------------------------------------------------------------
@@ -540,44 +549,12 @@ iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters
540iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
549iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
541
550
542-------------------------------------------------------------------------------
551-------------------------------------------------------------------------------
543−-- Zipping and concat
552+-- Combining streams
544-------------------------------------------------------------------------------
553-------------------------------------------------------------------------------
545
554
546−{-# INLINE zip #-}
555+-------------------------------------------------------------------------------
547−zip :: Int -> Int -> IO ()
556+-- Appending
548−zip count n =
557+-------------------------------------------------------------------------------
549− S.drain $ S.zipWith (,)
550− (sourceUnfoldrMN count n)
551− (sourceUnfoldrMN count (n + 1))
552−
553−#ifdef INSPECTION
554−inspect $ hasNoTypeClasses 'zip
555−inspect $ 'zip `hasNoType` ''D.Step
556−#endif
557−
558−{-# INLINE zipM #-}
559−zipM :: Int -> Int -> IO ()
560−zipM count n =
561− S.drain $ S.zipWithM (curry return)
562− (sourceUnfoldrMN count n)
563− (sourceUnfoldrMN count (n + 1))
564−
565−#ifdef INSPECTION
566−inspect $ hasNoTypeClasses 'zipM
567−inspect $ 'zipM `hasNoType` ''D.Step
568−#endif
569−
570−{-# INLINE mergeBy #-}
571−mergeBy :: Int -> Int -> IO ()
572−mergeBy count n =
573− S.drain $ S.mergeBy P.compare
574− (sourceUnfoldrMN count n)
575− (sourceUnfoldrMN count (n + 1))
576−
577−#ifdef INSPECTION
578−inspect $ hasNoTypeClasses 'mergeBy
579−inspect $ 'mergeBy `hasNoType` ''D.Step
580−#endif
581
558
582{-# INLINE serial2 #-}
559{-# INLINE serial2 #-}
583serial2 :: Int -> Int -> IO ()
560serial2 :: Int -> Int -> IO ()
@@ -616,6 +593,10 @@ inspect $ hasNoTypeClasses 'append2
616inspect $ 'append2 `hasNoType` ''D.AppendState
593inspect $ 'append2 `hasNoType` ''D.AppendState
617#endif
594#endif
618
595
596+-------------------------------------------------------------------------------
597+-- Interleaving
598+-------------------------------------------------------------------------------
599+
619{-# INLINE wSerial2 #-}
600{-# INLINE wSerial2 #-}
620wSerial2 :: Int -> IO ()
601wSerial2 :: Int -> IO ()
621wSerial2 n = S.drain $ S.wSerial
602wSerial2 n = S.drain $ S.wSerial
@@ -644,18 +625,49 @@ inspect $ hasNoTypeClasses 'roundRobin2
644inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
625inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
645#endif
626#endif
646
627
647−{-# INLINE isPrefixOf #-}
628+-------------------------------------------------------------------------------
648−{-# INLINE isSubsequenceOf #-}
629+-- Merging
649−isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
630+-------------------------------------------------------------------------------
650
631
651−isPrefixOf src = S.isPrefixOf src src
632+{-# INLINE mergeBy #-}
652−isSubsequenceOf src = S.isSubsequenceOf src src
633+mergeBy :: Int -> Int -> IO ()
634+mergeBy count n =
635+ S.drain $ S.mergeBy P.compare
636+ (sourceUnfoldrMN count n)
637+ (sourceUnfoldrMN count (n + 1))
653
638
639+#ifdef INSPECTION
640+inspect $ hasNoTypeClasses 'mergeBy
641+inspect $ 'mergeBy `hasNoType` ''D.Step
642+#endif
643+
644+-------------------------------------------------------------------------------
645+-- Zipping
646+-------------------------------------------------------------------------------
647+
654−{-# INLINE stripPrefix #-}
648+{-# INLINE zip #-}
655−stripPrefix :: Monad m => Stream m Int -> m ()
649+zip :: Int -> Int -> IO ()
656−stripPrefix src = do
650+zip count n =
657− _ <- S.stripPrefix src src
651+ S.drain $ S.zipWith (,)
658− return ()
652+ (sourceUnfoldrMN count n)
653+ (sourceUnfoldrMN count (n + 1))
654+
655+#ifdef INSPECTION
656+inspect $ hasNoTypeClasses 'zip
657+inspect $ 'zip `hasNoType` ''D.Step
658+#endif
659+
660+{-# INLINE zipM #-}
661+zipM :: Int -> Int -> IO ()
662+zipM count n =
663+ S.drain $ S.zipWithM (curry return)
664+ (sourceUnfoldrMN count n)
665+ (sourceUnfoldrMN count (n + 1))
666+
667+#ifdef INSPECTION
668+inspect $ hasNoTypeClasses 'zipM
669+inspect $ 'zipM `hasNoType` ''D.Step
670+#endif
659
671
660{-# INLINE zipAsync #-}
672{-# INLINE zipAsync #-}
661{-# INLINE zipAsyncM #-}
673{-# INLINE zipAsyncM #-}
@@ -678,6 +690,23 @@ zipAsyncAp src = do
678 transform (S.zipAsyncly $ (,) <$> S.serially src
690 transform (S.zipAsyncly $ (,) <$> S.serially src
679 <*> S.serially src1)
691 <*> S.serially src1)
680
692
693+-------------------------------------------------------------------------------
694+-- Multi-stream folds
695+-------------------------------------------------------------------------------
696+
697+{-# INLINE isPrefixOf #-}
698+{-# INLINE isSubsequenceOf #-}
699+isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
700+
701+isPrefixOf src = S.isPrefixOf src src
702+isSubsequenceOf src = S.isSubsequenceOf src src
703+
704+{-# INLINE stripPrefix #-}
705+stripPrefix :: Monad m => Stream m Int -> m ()
706+stripPrefix src = do
707+ _ <- S.stripPrefix src src
708+ return ()
709+
681{-# INLINE eqBy' #-}
710{-# INLINE eqBy' #-}
682eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
711eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
683eqBy' src = S.eqBy (==) src src
712eqBy' src = S.eqBy (==) src src
@@ -723,6 +752,35 @@ inspect $ hasNoTypeClasses 'cmpByPure
723inspect $ 'cmpByPure `hasNoType` ''D.Step
752inspect $ 'cmpByPure `hasNoType` ''D.Step
724#endif
753#endif
725
754
755+-------------------------------------------------------------------------------
756+-- Streams of streams
757+-------------------------------------------------------------------------------
758+
759+-- Special cases of concatMap
760+
761+{-# INLINE sourceFoldMapWith #-}
762+sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
763+ => Int -> t m Int
764+sourceFoldMapWith n = S.foldMapWith (S.<>) S.yield [n..n+value]
765+
766+{-# INLINE sourceFoldMapWithM #-}
767+sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
768+ => Int -> t m Int
769+sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
770+
771+{-# INLINE sourceFoldMapM #-}
772+sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))
773+ => Int -> t m Int
774+sourceFoldMapM n = F.foldMap (S.yieldM . return) [n..n+value]
775+
776+{-# INLINE sourceConcatMapId #-}
777+sourceConcatMapId :: (S.IsStream t, Monad m)
778+ => Int -> t m Int
779+sourceConcatMapId n =
780+ S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]
781+
782+-- concatMap unfoldrM/unfoldrM
783+
726{-# INLINE concatMap #-}
784{-# INLINE concatMap #-}
727concatMap :: Int -> Int -> Int -> IO ()
785concatMap :: Int -> Int -> Int -> IO ()
728concatMap outer inner n =
786concatMap outer inner n =
@@ -734,6 +792,8 @@ concatMap outer inner n =
734inspect $ hasNoTypeClasses 'concatMap
792inspect $ hasNoTypeClasses 'concatMap
735#endif
793#endif
736
794
795+-- concatMap unfoldr/unfoldr
796+
737{-# INLINE concatMapPure #-}
797{-# INLINE concatMapPure #-}
738concatMapPure :: Int -> Int -> Int -> IO ()
798concatMapPure :: Int -> Int -> Int -> IO ()
739concatMapPure outer inner n =
799concatMapPure outer inner n =
@@ -745,6 +805,8 @@ concatMapPure outer inner n =
745inspect $ hasNoTypeClasses 'concatMapPure
805inspect $ hasNoTypeClasses 'concatMapPure
746#endif
806#endif
747
807
808+-- concatMap replicate/unfoldrM
809+
748{-# INLINE concatMapRepl4xN #-}
810{-# INLINE concatMapRepl4xN #-}
749concatMapRepl4xN :: Int -> IO ()
811concatMapRepl4xN :: Int -> IO ()
750concatMapRepl4xN n = S.drain $ S.concatMap (S.replicate 4)
812concatMapRepl4xN n = S.drain $ S.concatMap (S.replicate 4)
@@ -754,17 +816,7 @@ concatMapRepl4xN n = S.drain $ S.concatMap (S.replicate 4)
754inspect $ hasNoTypeClasses 'concatMapRepl4xN
816inspect $ hasNoTypeClasses 'concatMapRepl4xN
755#endif
817#endif
756
818
757−{-# INLINE concatUnfoldRepl4xN #-}
819+-- concatMapWith
758−concatUnfoldRepl4xN :: Int -> IO ()
759−concatUnfoldRepl4xN n =
760− S.drain $ S.concatUnfold
761− (UF.replicateM 4)
762− (sourceUnfoldrMN (value `div` 4) n)
763−
764−#ifdef INSPECTION
765−inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
766−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
767−#endif
768
820
769{-# INLINE concatMapWithSerial #-}
821{-# INLINE concatMapWithSerial #-}
770concatMapWithSerial :: Int -> Int -> Int -> IO ()
822concatMapWithSerial :: Int -> Int -> Int -> IO ()
@@ -799,6 +851,22 @@ concatMapWithWSerial outer inner n =
799inspect $ hasNoTypeClasses 'concatMapWithWSerial
851inspect $ hasNoTypeClasses 'concatMapWithWSerial
800#endif
852#endif
801
853
854+-- concatUnfold
855+
856+-- concatUnfold replicate/unfoldrM
857+
858+{-# INLINE concatUnfoldRepl4xN #-}
859+concatUnfoldRepl4xN :: Int -> IO ()
860+concatUnfoldRepl4xN n =
861+ S.drain $ S.concatUnfold
862+ (UF.replicateM 4)
863+ (sourceUnfoldrMN (value `div` 4) n)
864+
865+#ifdef INSPECTION
866+inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
867+inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
868+#endif
869+
802{-# INLINE concatUnfoldInterleaveRepl4xN #-}
870{-# INLINE concatUnfoldInterleaveRepl4xN #-}
803concatUnfoldInterleaveRepl4xN :: Int -> IO ()
871concatUnfoldInterleaveRepl4xN :: Int -> IO ()
804concatUnfoldInterleaveRepl4xN n =
872concatUnfoldInterleaveRepl4xN n =
@@ -824,7 +892,33 @@ inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
824#endif
892#endif
825
893
826-------------------------------------------------------------------------------
894-------------------------------------------------------------------------------
895+-- Monad transformation (hoisting etc.)
896+-------------------------------------------------------------------------------
897+
898+{-# INLINE sourceUnfoldrState #-}
899+sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
900+ => Int -> t (StateT Int m) Int
901+sourceUnfoldrState n = S.unfoldrM step n
902+ where
903+ step cnt =
904+ if cnt > n + value
905+ then return Nothing
906+ else do
907+ s <- get
908+ put (s + 1)
909+ return (Just (s, cnt + 1))
910+
911+{-# INLINE evalStateT #-}
912+evalStateT :: S.MonadAsync m => Int -> Stream m Int
913+evalStateT n = Internal.evalStateT 0 (sourceUnfoldrState n)
914+
915+{-# INLINE withState #-}
916+withState :: S.MonadAsync m => Int -> Stream m Int
917+withState n =
918+ Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM n))
919+
920+-------------------------------------------------------------------------------
827−-- Parallel application/fold
921+-- Concurrent application/fold
828-------------------------------------------------------------------------------
922-------------------------------------------------------------------------------
829
923
830{-# INLINE parAppMap #-}
924{-# INLINE parAppMap #-}
@@ -836,49 +930,7 @@ parAppSum :: S.MonadAsync m => Stream m Int -> m ()
836parAppSum src = (S.sum S.|$. src) >>= \x -> P.seq x (return ())
930parAppSum src = (S.sum S.|$. src) >>= \x -> P.seq x (return ())
837
931
838-------------------------------------------------------------------------------
932-------------------------------------------------------------------------------
839−-- Mixed Composition
933+-- Type class instances
840−-------------------------------------------------------------------------------
841−
842−{-# INLINE scanMap #-}
843−{-# INLINE dropMap #-}
844−{-# INLINE dropScan #-}
845−{-# INLINE takeDrop #-}
846−{-# INLINE takeScan #-}
847−{-# INLINE takeMap #-}
848−{-# INLINE filterDrop #-}
849−{-# INLINE filterTake #-}
850−{-# INLINE filterScan #-}
851−{-# INLINE filterScanl1 #-}
852−{-# INLINE filterMap #-}
853−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
854− filterTake, filterScan, filterScanl1, filterMap
855− :: MonadIO m => Int -> Stream m Int -> m ()
856−
857−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
858−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
859−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
860−takeDrop n = composeN n $ S.drop 1 . S.take maxValue
861−takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
862−takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
863−filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
864−filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
865−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
866−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
867−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
868−
869−data Pair a b = Pair !a !b deriving (Generic, NFData)
870−
871−{-# INLINE sumProductFold #-}
872−sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
873−sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
874−
875−{-# INLINE sumProductScan #-}
876−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
877−sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
878− . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
879−
880−-------------------------------------------------------------------------------
881−-- Pure stream operations
882-------------------------------------------------------------------------------
934-------------------------------------------------------------------------------
883
935
884{-# INLINE eqInstance #-}
936{-# INLINE eqInstance #-}
@@ -921,6 +973,10 @@ readInstanceList str =
921 [(x,"")] -> x
973 [(x,"")] -> x
922 _ -> P.error "readInstance: no parse"
974 _ -> P.error "readInstance: no parse"
923
975
976+-------------------------------------------------------------------------------
977+-- Pure (Identity) streams
978+-------------------------------------------------------------------------------
979+
924{-# INLINE pureFoldl' #-}
980{-# INLINE pureFoldl' #-}
925pureFoldl' :: Stream Identity Int -> Int
981pureFoldl' :: Stream Identity Int -> Int
926pureFoldl' = runIdentity . S.foldl' (+) 0
982pureFoldl' = runIdentity . S.foldl' (+) 0