@@ -38,13 +38,15 @@ import qualified Data.Foldable as F
3838import qualified GHC.Exts as GHC
3939
4040#ifdef INSPECTION
41−import Streamly.Streams.StreamD.Type (Step(..))
4241import Test.Inspection
42+
43+import qualified Streamly.Streams.StreamD as D
4344#endif
4445
4546import qualified Streamly as S hiding (foldMapWith, runStream)
4647import qualified Streamly.Prelude as S
4748import qualified Streamly.Internal as Internal
49+import qualified Streamly.Unfold as UF
4850-- import qualified Streamly.Pipe as Pipe
4951
5052value, maxValue, value2 :: Int
@@ -132,6 +134,12 @@ sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))
132134 => Int -> t m Int
133135sourceFoldMapM n = F.foldMap (S.yieldM . return) [n..n+value]
134136
137+{-# INLINE sourceConcatMapId #-}
138+sourceConcatMapId :: (S.IsStream t, Monad m)
139+ => Int -> t m Int
140+sourceConcatMapId n =
141+ S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]
142+
135143{-# INLINE sourceUnfoldr #-}
136144sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int
137145sourceUnfoldr n = S.unfoldr step n
@@ -503,44 +511,105 @@ iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
503511-------------------------------------------------------------------------------
504512
505513{-# INLINE zip #-}
506−zip :: Monad m => Stream m Int -> m ()
507−zip src = do
508− r <- S.tail src
509− let src1 = fromJust r
510− transform (S.zipWith (,) src src1)
514+zip :: Int -> Int -> IO ()
515+zip count n =
516+ S.drain $ S.zipWith (,)
517+ (sourceUnfoldrMN count n)
518+ (sourceUnfoldrMN count (n + 1))
511519
512−{-# INLINE zipM' #-}
513−zipM' :: Monad m => Stream m Int -> m ()
514−zipM' src = do
515− r <- S.tail src
516− let src1 = fromJust r
517− transform (S.zipWithM (curry return) src src1)
520+#ifdef INSPECTION
521+inspect $ hasNoTypeClasses 'zip
522+inspect $ 'zip `hasNoType` ''D.Step
523+#endif
518524
519525{-# INLINE zipM #-}
520−zipM :: Int -> IO ()
521−zipM n = zipM' $ source n
526+zipM :: Int -> Int -> IO ()
527+zipM count n =
528+ S.drain $ S.zipWithM (curry return)
529+ (sourceUnfoldrMN count n)
530+ (sourceUnfoldrMN count (n + 1))
522531
523532#ifdef INSPECTION
524533inspect $ hasNoTypeClasses 'zipM
525−-- inspect $ 'zipM `hasNoType` ''Step
534+inspect $ 'zipM `hasNoType` ''D.Step
526535#endif
527536
528−{-# INLINE mergeBy' #-}
529−mergeBy' :: Monad m => Stream m Int -> m ()
530−mergeBy' src = do
531− r <- S.tail src
532− let src1 = fromJust r
533− transform (S.mergeBy P.compare src src1)
534−
535537{-# INLINE mergeBy #-}
536−mergeBy :: Int -> IO ()
537−mergeBy n = mergeBy' $ source n
538+mergeBy :: Int -> Int -> IO ()
539+mergeBy count n =
540+ S.drain $ S.mergeBy P.compare
541+ (sourceUnfoldrMN count n)
542+ (sourceUnfoldrMN count (n + 1))
538543
539544#ifdef INSPECTION
540545inspect $ hasNoTypeClasses 'mergeBy
541−-- inspect $ 'mergeBy `hasNoType` ''Step
546+inspect $ 'mergeBy `hasNoType` ''D.Step
547+#endif
548+
549+{-# INLINE serial2 #-}
550+serial2 :: Int -> Int -> IO ()
551+serial2 count n =
552+ S.drain $ S.serial
553+ (sourceUnfoldrMN count n)
554+ (sourceUnfoldrMN count (n + 1))
555+
556+{-# INLINE serial4 #-}
557+serial4 :: Int -> Int -> IO ()
558+serial4 count n =
559+ S.drain $ S.serial
560+ ((S.serial (sourceUnfoldrMN count n)
561+ (sourceUnfoldrMN count (n + 1))))
562+ ((S.serial (sourceUnfoldrMN count (n+2))
563+ (sourceUnfoldrMN count (n + 3))))
564+
565+{-# INLINE append2 #-}
566+append2 :: Int -> Int -> IO ()
567+append2 count n =
568+ S.drain $ Internal.append
569+ (sourceUnfoldrMN count n)
570+ (sourceUnfoldrMN count (n + 1))
571+
572+{-# INLINE append4 #-}
573+append4 :: Int -> Int -> IO ()
574+append4 count n =
575+ S.drain $ Internal.append
576+ ((Internal.append (sourceUnfoldrMN count n)
577+ (sourceUnfoldrMN count (n + 1))))
578+ ((Internal.append (sourceUnfoldrMN count (n+2))
579+ (sourceUnfoldrMN count (n + 3))))
580+
581+#ifdef INSPECTION
582+inspect $ hasNoTypeClasses 'append2
583+inspect $ 'append2 `hasNoType` ''D.AppendState
542584#endif
543585
586+{-# INLINE wSerial2 #-}
587+wSerial2 :: Int -> IO ()
588+wSerial2 n = S.drain $ S.wSerial
589+ (sourceUnfoldrMN (value `div` 2) n)
590+ (sourceUnfoldrMN (value `div` 2) (n + 1))
591+
592+{-# INLINE interleave2 #-}
593+interleave2 :: Int -> IO ()
594+interleave2 n = S.drain $ Internal.interleave
595+ (sourceUnfoldrMN (value `div` 2) n)
596+ (sourceUnfoldrMN (value `div` 2) (n + 1))
597+
598+#ifdef INSPECTION
599+inspect $ hasNoTypeClasses 'interleave2
600+inspect $ 'interleave2 `hasNoType` ''D.InterleaveState
601+#endif
602+
603+{-# INLINE roundRobin2 #-}
604+roundRobin2 :: Int -> IO ()
605+roundRobin2 n = S.drain $ Internal.roundrobin
606+ (sourceUnfoldrMN (value `div` 2) n)
607+ (sourceUnfoldrMN (value `div` 2) (n + 1))
608+
609+#ifdef INSPECTION
610+inspect $ hasNoTypeClasses 'roundRobin2
611+inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
612+#endif
544613
545614{-# INLINE isPrefixOf #-}
546615{-# INLINE isSubsequenceOf #-}
@@ -586,7 +655,7 @@ eqBy n = eqBy' (source n)
586655
587656#ifdef INSPECTION
588657inspect $ hasNoTypeClasses 'eqBy
589−inspect $ 'eqBy `hasNoType` ''Step
658+inspect $ 'eqBy `hasNoType` ''D.Step
590659#endif
591660
592661
@@ -596,7 +665,7 @@ eqByPure n = eqBy' (sourceUnfoldr n)
596665
597666#ifdef INSPECTION
598667inspect $ hasNoTypeClasses 'eqByPure
599−inspect $ 'eqByPure `hasNoType` ''Step
668+inspect $ 'eqByPure `hasNoType` ''D.Step
600669#endif
601670
602671{-# INLINE cmpBy' #-}
@@ -609,7 +678,7 @@ cmpBy n = cmpBy' (source n)
609678
610679#ifdef INSPECTION
611680inspect $ hasNoTypeClasses 'cmpBy
612−inspect $ 'cmpBy `hasNoType` ''Step
681+inspect $ 'cmpBy `hasNoType` ''D.Step
613682#endif
614683
615684{-# INLINE cmpByPure #-}
@@ -618,38 +687,29 @@ cmpByPure n = cmpBy' (sourceUnfoldr n)
618687
619688#ifdef INSPECTION
620689inspect $ hasNoTypeClasses 'cmpByPure
621−inspect $ 'cmpByPure `hasNoType` ''Step
690+inspect $ 'cmpByPure `hasNoType` ''D.Step
622691#endif
623692
624−-- The worst case for concatMap, concat a 1 element stream n times.
625693{-# INLINE concatMap #-}
626−concatMap :: Int -> IO ()
627−concatMap n = S.drain $ S.concatMap (\_ -> sourceUnfoldrMN 1 n)
628− (sourceUnfoldrMN value n)
694+concatMap :: Int -> Int -> Int -> IO ()
695+concatMap outer inner n =
696+ S.drain $ S.concatMap
697+ (\_ -> sourceUnfoldrMN inner n)
698+ (sourceUnfoldrMN outer n)
629699
630700#ifdef INSPECTION
631701inspect $ hasNoTypeClasses 'concatMap
632702#endif
633703
634−{-# INLINE concatMapPure1xN #-}
635−concatMapPure1xN :: Int -> IO ()
636−concatMapPure1xN n = S.drain $ S.concatMap (\_ -> sourceUnfoldrN 1 n)
637− (sourceUnfoldrN value n)
638−
639−#ifdef INSPECTION
640−inspect $ hasNoTypeClasses 'concatMapPure1xN
641−#endif
642−
643−-- We use a (sqrt n) element stream as source and then generate and concat a
644−-- (sqrt n) element stream for each element of the source to produce an n
645−-- element stream.
646−{-# INLINE concatMapNxN #-}
647−concatMapNxN :: Int -> IO ()
648−concatMapNxN n = S.drain $ S.concatMap (\_ -> sourceUnfoldrMN value2 n)
649− (sourceUnfoldrMN value2 n)
704+{-# INLINE concatMapPure #-}
705+concatMapPure :: Int -> Int -> Int -> IO ()
706+concatMapPure outer inner n =
707+ S.drain $ S.concatMap
708+ (\_ -> sourceUnfoldrN inner n)
709+ (sourceUnfoldrN outer n)
650710
651711#ifdef INSPECTION
652−inspect $ hasNoTypeClasses 'concatMapNxN
712+inspect $ hasNoTypeClasses 'concatMapPure
653713#endif
654714
655715{-# INLINE concatMapRepl4xN #-}
@@ -661,6 +721,75 @@ concatMapRepl4xN n = S.drain $ S.concatMap (S.replicate 4)
661721inspect $ hasNoTypeClasses 'concatMapRepl4xN
662722#endif
663723
724+{-# INLINE concatUnfoldRepl4xN #-}
725+concatUnfoldRepl4xN :: Int -> IO ()
726+concatUnfoldRepl4xN n =
727+ S.drain $ Internal.concatMapU
728+ (UF.replicateM 4)
729+ (sourceUnfoldrMN (value `div` 4) n)
730+
731+#ifdef INSPECTION
732+inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
733+inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
734+#endif
735+
736+{-# INLINE concatMapWithSerial #-}
737+concatMapWithSerial :: Int -> Int -> Int -> IO ()
738+concatMapWithSerial outer inner n =
739+ S.drain $ S.concatMapWith S.serial
740+ (\_ -> sourceUnfoldrMN inner n)
741+ (sourceUnfoldrMN outer n)
742+
743+#ifdef INSPECTION
744+inspect $ hasNoTypeClasses 'concatMapWithSerial
745+#endif
746+
747+{-# INLINE concatMapWithAppend #-}
748+concatMapWithAppend :: Int -> Int -> Int -> IO ()
749+concatMapWithAppend outer inner n =
750+ S.drain $ S.concatMapWith Internal.append
751+ (\_ -> sourceUnfoldrMN inner n)
752+ (sourceUnfoldrMN outer n)
753+
754+#ifdef INSPECTION
755+inspect $ hasNoTypeClasses 'concatMapWithAppend
756+#endif
757+
758+{-# INLINE concatMapWithWSerial #-}
759+concatMapWithWSerial :: Int -> Int -> Int -> IO ()
760+concatMapWithWSerial outer inner n =
761+ S.drain $ S.concatMapWith S.wSerial
762+ (\_ -> sourceUnfoldrMN inner n)
763+ (sourceUnfoldrMN outer n)
764+
765+#ifdef INSPECTION
766+inspect $ hasNoTypeClasses 'concatMapWithWSerial
767+#endif
768+
769+{-# INLINE concatUnfoldInterleaveRepl4xN #-}
770+concatUnfoldInterleaveRepl4xN :: Int -> IO ()
771+concatUnfoldInterleaveRepl4xN n =
772+ S.drain $ Internal.concatUnfoldInterleave
773+ (UF.replicateM 4)
774+ (sourceUnfoldrMN (value `div` 4) n)
775+
776+#ifdef INSPECTION
777+inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
778+-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
779+#endif
780+
781+{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
782+concatUnfoldRoundrobinRepl4xN :: Int -> IO ()
783+concatUnfoldRoundrobinRepl4xN n =
784+ S.drain $ Internal.concatUnfoldRoundrobin
785+ (UF.replicateM 4)
786+ (sourceUnfoldrMN (value `div` 4) n)
787+
788+#ifdef INSPECTION
789+inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
790+-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
791+#endif
792+
664793-------------------------------------------------------------------------------
665794-- Mixed Composition
666795-------------------------------------------------------------------------------