git.iko.soy/streamly
on master help sign in
Add pure stream (list) instances
c28043fHarendra Kumar
benchmark/BaseStreams.hs+8−2
compare with master
unifiedsplit
@@ -99,7 +99,11 @@ main =
99 , benchIO "dropWhile-true" (D.dropWhileTrue 4) D.sourceUnfoldrM
99 , benchIO "dropWhile-true" (D.dropWhileTrue 4) D.sourceUnfoldrM
100 , benchIO "dropWhile-false" (D.dropWhileFalse 4) D.sourceUnfoldrM
100 , benchIO "dropWhile-false" (D.dropWhileFalse 4) D.sourceUnfoldrM
101 ]
101 ]
102+ , bgroup "zipping"
103+ [ benchFold "eqBy" D.eqBy D.sourceUnfoldrM
104+ , benchFold "cmpBy" D.cmpBy D.sourceUnfoldrM
102− , benchIO "zip" D.zip D.sourceUnfoldrM
105+ , benchIO "zip" D.zip D.sourceUnfoldrM
106+ ]
103 , bgroup "mixed"
107 , bgroup "mixed"
104 [ benchIO "scan-map" (D.scanMap 1) D.sourceUnfoldrM
108 [ benchIO "scan-map" (D.scanMap 1) D.sourceUnfoldrM
105 , benchIO "drop-map" (D.dropMap 1) D.sourceUnfoldrM
109 , benchIO "drop-map" (D.dropMap 1) D.sourceUnfoldrM
@@ -206,7 +210,9 @@ main =
206 , benchIO "dropWhile-true" (K.dropWhileTrue 4) K.sourceUnfoldrM
210 , benchIO "dropWhile-true" (K.dropWhileTrue 4) K.sourceUnfoldrM
207 , benchIO "dropWhile-false" (K.dropWhileFalse 4) K.sourceUnfoldrM
211 , benchIO "dropWhile-false" (K.dropWhileFalse 4) K.sourceUnfoldrM
208 ]
212 ]
213+ , bgroup "zipping"
209− , benchIO "zip" K.zip K.sourceUnfoldrM
214+ [ benchIO "zip" K.zip K.sourceUnfoldrM
215+ ]
210 , bgroup "mixed"
216 , bgroup "mixed"
211 [ benchIO "scan-map" (K.scanMap 1) K.sourceUnfoldrM
217 [ benchIO "scan-map" (K.scanMap 1) K.sourceUnfoldrM
212 , benchIO "drop-map" (K.dropMap 1) K.sourceUnfoldrM
218 , benchIO "drop-map" (K.dropMap 1) K.sourceUnfoldrM
benchmark/Chart.hs+1−1
@@ -119,7 +119,7 @@ makeLinearGraphs cfg@Config{..} inputFile = do
119 { title = (++) <$> title <*> Just " Transformation & Zip"
119 { title = (++) <$> title <*> Just " Transformation & Zip"
120 , classifyBenchmark = \b ->
120 , classifyBenchmark = \b ->
121 if "serially/transformation/" `isPrefixOf` b
121 if "serially/transformation/" `isPrefixOf` b
122− || "serially/zip" `isPrefixOf` b
122+ || "serially/zipping" `isPrefixOf` b
123 then Just ("Streamly", last $ splitOn "/" b)
123 then Just ("Streamly", last $ splitOn "/" b)
124 else Nothing
124 else Nothing
125 }
125 }
benchmark/Linear.hs+140−108
@@ -6,157 +6,189 @@
6-- Maintainer : harendra.kumar@gmail.com
6-- Maintainer : harendra.kumar@gmail.com
7
7
8import Control.DeepSeq (NFData)
8import Control.DeepSeq (NFData)
9−-- import Data.Functor.Identity (Identity, runIdentity)
9+import Data.Functor.Identity (Identity, runIdentity)
10import System.Random (randomRIO)
10import System.Random (randomRIO)
11+
12+import qualified GHC.Exts as GHC
11import qualified LinearOps as Ops
13import qualified LinearOps as Ops
12
14
13import Streamly
15import Streamly
16+import qualified Streamly.Prelude as S
14import Gauge
17import Gauge
15
18
16-- We need a monadic bind here to make sure that the function f does not get
19-- We need a monadic bind here to make sure that the function f does not get
17-- completely optimized out by the compiler in some cases.
20-- completely optimized out by the compiler in some cases.
18−--
21+
19-- | Takes a fold method, and uses it with a default source.
22-- | Takes a fold method, and uses it with a default source.
20−{-# INLINE benchIO #-}
23+{-# INLINE benchIOSink #-}
24+benchIOSink
25+ :: (IsStream t, NFData b)
21−benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark
26+ => String -> (t IO Int -> IO b) -> Benchmark
22−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source
27+benchIOSink name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source
23
28
24-- | Takes a source, and uses it with a default drain/fold method.
29-- | Takes a source, and uses it with a default drain/fold method.
25−{-# INLINE benchSrcIO #-}
30+{-# INLINE benchIOSrc #-}
26−benchSrcIO
31+benchIOSrc
27 :: (t IO Int -> SerialT IO Int)
32 :: (t IO Int -> SerialT IO Int)
28 -> String
33 -> String
29 -> (Int -> t IO Int)
34 -> (Int -> t IO Int)
30 -> Benchmark
35 -> Benchmark
31−benchSrcIO t name f
36+benchIOSrc t name f =
32− = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
37+ bench name $ nfIO $ randomRIO (1,1) >>= (Ops.toNull t) . f
38+
39+{-# INLINE benchPure #-}
40+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark
41+benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src
33
42
34−{-
43+{-# INLINE benchPureSink #-}
44+benchPureSink :: NFData b => String -> (SerialT Identity Int -> b) -> Benchmark
45+benchPureSink name f = benchPure name Ops.sourceUnfoldr f
46+
47+{-# INLINE benchPureSrc #-}
35−_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
48+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
36−_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
49+benchPureSrc name src = benchPure name src (runIdentity . runStream)
37−-}
38
50
39main :: IO ()
51main :: IO ()
40main =
52main =
41 defaultMain
53 defaultMain
42 [ bgroup "serially"
54 [ bgroup "serially"
55+ [ bgroup "pure"
56+ [ benchPureSink "eqBy" Ops.eqBy
57+ , benchPureSink "==" Ops.eqInstance
58+ , benchPureSink "/=" Ops.eqInstanceNotEq
59+ , benchPureSink "cmpBy" Ops.cmpBy
60+ , benchPureSink "<" Ops.ordInstance
61+ , benchPureSink "min" Ops.ordInstanceMin
62+ , benchPureSrc "IsList.fromList" Ops.sourceIsList
63+ , benchPureSink "IsList.toList" GHC.toList
64+ , benchPureSrc "IsString.fromString" Ops.sourceIsString
65+ , benchPure "readsPrec" (\n -> S.fromList [1..n :: Int])
66+ Ops.readInstance
67+ , benchPureSink "showsPrec" Ops.showInstance
68+ , benchPure "showsPrecList" (\n -> S.fromList [1..n :: Int])
69+ Ops.showInstanceList
70+ ]
43− [ bgroup "generation"
71+ , bgroup "generation"
44 [ -- Most basic, barely stream continuations running
72 [ -- Most basic, barely stream continuations running
45− benchSrcIO serially "unfoldr" Ops.sourceUnfoldr
73+ benchIOSrc serially "unfoldr" Ops.sourceUnfoldr
46− , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
74+ , benchIOSrc serially "unfoldrM" Ops.sourceUnfoldrM
47− , benchSrcIO serially "fromList" Ops.sourceFromList
75+ , benchIOSrc serially "fromList" Ops.sourceFromList
48− , benchSrcIO serially "fromListM" Ops.sourceFromListM
76+ , benchIOSrc serially "fromListM" Ops.sourceFromListM
49 -- These are essentially cons and consM
77 -- These are essentially cons and consM
50− , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable
78+ , benchIOSrc serially "fromFoldable" Ops.sourceFromFoldable
51− , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM
79+ , benchIOSrc serially "fromFoldableM" Ops.sourceFromFoldableM
52 -- These are essentially appends
80 -- These are essentially appends
53− , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith
81+ , benchIOSrc serially "foldMapWith" Ops.sourceFoldMapWith
54− , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM
82+ , benchIOSrc serially "foldMapWithM" Ops.sourceFoldMapWithM
55 ]
83 ]
56 , bgroup "elimination"
84 , bgroup "elimination"
57− [ benchIO "toNull" $ Ops.toNull serially
85+ [ benchIOSink "toNull" $ Ops.toNull serially
58− , benchIO "uncons" Ops.uncons
86+ , benchIOSink "uncons" Ops.uncons
59− , benchIO "init" Ops.init
87+ , benchIOSink "init" Ops.init
60− , benchIO "tail" Ops.tail
88+ , benchIOSink "tail" Ops.tail
61− , benchIO "nullHeadTail" Ops.nullHeadTail
89+ , benchIOSink "nullHeadTail" Ops.nullHeadTail
62− , benchIO "mapM_" Ops.mapM_
90+ , benchIOSink "mapM_" Ops.mapM_
63− , benchIO "toList" Ops.toList
91+ , benchIOSink "toList" Ops.toList
64− , benchIO "foldr" Ops.foldr
92+ , benchIOSink "foldr" Ops.foldr
65− , benchIO "foldr1" Ops.foldr1
93+ , benchIOSink "foldr1" Ops.foldr1
66− , benchIO "foldrM" Ops.foldrM
94+ , benchIOSink "foldrM" Ops.foldrM
67− , benchIO "foldl'" Ops.foldl'
95+ , benchIOSink "foldl'" Ops.foldl'
68− , benchIO "foldl1'" Ops.foldl1'
96+ , benchIOSink "foldl1'" Ops.foldl1'
69
97
70− , benchIO "last" Ops.last
98+ , benchIOSink "last" Ops.last
71− , benchIO "length" Ops.length
99+ , benchIOSink "length" Ops.length
72− , benchIO "elem" Ops.elem
100+ , benchIOSink "elem" Ops.elem
73− , benchIO "notElem" Ops.notElem
101+ , benchIOSink "notElem" Ops.notElem
74− , benchIO "all" Ops.all
102+ , benchIOSink "all" Ops.all
75− , benchIO "any" Ops.any
103+ , benchIOSink "any" Ops.any
76− , benchIO "and" Ops.and
104+ , benchIOSink "and" Ops.and
77− , benchIO "or" Ops.or
105+ , benchIOSink "or" Ops.or
78− , benchIO "find" Ops.find
106+ , benchIOSink "find" Ops.find
79− , benchIO "findIndex" Ops.findIndex
107+ , benchIOSink "findIndex" Ops.findIndex
80− , benchIO "elemIndex" Ops.elemIndex
108+ , benchIOSink "elemIndex" Ops.elemIndex
81− , benchIO "maximum" Ops.maximum
109+ , benchIOSink "maximum" Ops.maximum
82− , benchIO "minimum" Ops.minimum
110+ , benchIOSink "minimum" Ops.minimum
83− , benchIO "sum" Ops.sum
111+ , benchIOSink "sum" Ops.sum
84− , benchIO "product" Ops.product
112+ , benchIOSink "product" Ops.product
85 ]
113 ]
86 , bgroup "transformation"
114 , bgroup "transformation"
87− [ benchIO "scan" (Ops.scan 1)
115+ [ benchIOSink "scan" (Ops.scan 1)
88− , benchIO "map" (Ops.map 1)
116+ , benchIOSink "map" (Ops.map 1)
89− , benchIO "fmap" (Ops.fmap 1)
117+ , benchIOSink "fmap" (Ops.fmap 1)
90− , benchIO "mapM" (Ops.mapM serially 1)
118+ , benchIOSink "mapM" (Ops.mapM serially 1)
91− , benchIO "mapMaybe" (Ops.mapMaybe 1)
119+ , benchIOSink "mapMaybe" (Ops.mapMaybe 1)
92− , benchIO "mapMaybeM" (Ops.mapMaybeM 1)
120+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 1)
93 , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
121 , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
94 Ops.sequence serially (Ops.sourceUnfoldrMAction n)
122 Ops.sequence serially (Ops.sourceUnfoldrMAction n)
95− , benchIO "findIndices" (Ops.findIndices 1)
123+ , benchIOSink "findIndices" (Ops.findIndices 1)
96− , benchIO "elemIndices" (Ops.elemIndices 1)
124+ , benchIOSink "elemIndices" (Ops.elemIndices 1)
97− -- , benchIO "concat" Ops.concat
125+ -- , benchIOSink "concat" Ops.concat
98 ]
126 ]
99 , bgroup "transformationX4"
127 , bgroup "transformationX4"
100− [ benchIO "scan" (Ops.scan 4)
128+ [ benchIOSink "scan" (Ops.scan 4)
101− , benchIO "map" (Ops.map 4)
129+ , benchIOSink "map" (Ops.map 4)
102− , benchIO "fmap" (Ops.fmap 4)
130+ , benchIOSink "fmap" (Ops.fmap 4)
103− , benchIO "mapM" (Ops.mapM serially 4)
131+ , benchIOSink "mapM" (Ops.mapM serially 4)
104− , benchIO "mapMaybe" (Ops.mapMaybe 4)
132+ , benchIOSink "mapMaybe" (Ops.mapMaybe 4)
105− , benchIO "mapMaybeM" (Ops.mapMaybeM 4)
133+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 4)
106 -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
134 -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
107 -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)
135 -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)
108− , benchIO "findIndices" (Ops.findIndices 4)
136+ , benchIOSink "findIndices" (Ops.findIndices 4)
109− , benchIO "elemIndices" (Ops.elemIndices 4)
137+ , benchIOSink "elemIndices" (Ops.elemIndices 4)
110− -- , benchIO "concat" Ops.concat
138+ -- , benchIOSink "concat" Ops.concat
111 ]
139 ]
112 , bgroup "filtering"
140 , bgroup "filtering"
113− [ benchIO "filter-even" (Ops.filterEven 1)
141+ [ benchIOSink "filter-even" (Ops.filterEven 1)
114− , benchIO "filter-all-out" (Ops.filterAllOut 1)
142+ , benchIOSink "filter-all-out" (Ops.filterAllOut 1)
115− , benchIO "filter-all-in" (Ops.filterAllIn 1)
143+ , benchIOSink "filter-all-in" (Ops.filterAllIn 1)
116− , benchIO "take-all" (Ops.takeAll 1)
144+ , benchIOSink "take-all" (Ops.takeAll 1)
117− , benchIO "takeWhile-true" (Ops.takeWhileTrue 1)
145+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 1)
118− --, benchIO "takeWhileM-true" (Ops.takeWhileMTrue 1)
146+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 1)
119− , benchIO "drop-one" (Ops.dropOne 1)
147+ , benchIOSink "drop-one" (Ops.dropOne 1)
120− , benchIO "drop-all" (Ops.dropAll 1)
148+ , benchIOSink "drop-all" (Ops.dropAll 1)
121− , benchIO "dropWhile-true" (Ops.dropWhileTrue 1)
149+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 1)
122− --, benchIO "dropWhileM-true" (Ops.dropWhileMTrue 1)
150+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 1)
123− , benchIO "dropWhile-false" (Ops.dropWhileFalse 1)
151+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 1)
124 ]
152 ]
125 , bgroup "filteringX4"
153 , bgroup "filteringX4"
126− [ benchIO "filter-even" (Ops.filterEven 4)
154+ [ benchIOSink "filter-even" (Ops.filterEven 4)
127− , benchIO "filter-all-out" (Ops.filterAllOut 4)
155+ , benchIOSink "filter-all-out" (Ops.filterAllOut 4)
128− , benchIO "filter-all-in" (Ops.filterAllIn 4)
156+ , benchIOSink "filter-all-in" (Ops.filterAllIn 4)
129− , benchIO "take-all" (Ops.takeAll 4)
157+ , benchIOSink "take-all" (Ops.takeAll 4)
130− , benchIO "takeWhile-true" (Ops.takeWhileTrue 4)
158+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 4)
131− --, benchIO "takeWhileM-true" (Ops.takeWhileMTrue 4)
159+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 4)
132− , benchIO "drop-one" (Ops.dropOne 4)
160+ , benchIOSink "drop-one" (Ops.dropOne 4)
133− , benchIO "drop-all" (Ops.dropAll 4)
161+ , benchIOSink "drop-all" (Ops.dropAll 4)
134− , benchIO "dropWhile-true" (Ops.dropWhileTrue 4)
162+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 4)
135− --, benchIO "dropWhileM-true" (Ops.dropWhileMTrue 4)
163+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 4)
136− , benchIO "dropWhile-false" (Ops.dropWhileFalse 4)
164+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 4)
165+ ]
166+ , bgroup "zipping"
167+ [ benchIOSink "eqBy" Ops.eqBy
168+ , benchIOSink "cmpBy" Ops.cmpBy
169+ , benchIOSink "zip" Ops.zip
170+ , benchIOSink "zipM" Ops.zipM
137 ]
171 ]
138− , benchIO "zip" Ops.zip
139− , benchIO "zipM" Ops.zipM
140 , bgroup "mixedX4"
172 , bgroup "mixedX4"
141− [ benchIO "scan-map" (Ops.scanMap 4)
173+ [ benchIOSink "scan-map" (Ops.scanMap 4)
142− , benchIO "drop-map" (Ops.dropMap 4)
174+ , benchIOSink "drop-map" (Ops.dropMap 4)
143− , benchIO "drop-scan" (Ops.dropScan 4)
175+ , benchIOSink "drop-scan" (Ops.dropScan 4)
144− , benchIO "take-drop" (Ops.takeDrop 4)
176+ , benchIOSink "take-drop" (Ops.takeDrop 4)
145− , benchIO "take-scan" (Ops.takeScan 4)
177+ , benchIOSink "take-scan" (Ops.takeScan 4)
146− , benchIO "take-map" (Ops.takeMap 4)
178+ , benchIOSink "take-map" (Ops.takeMap 4)
147− , benchIO "filter-drop" (Ops.filterDrop 4)
179+ , benchIOSink "filter-drop" (Ops.filterDrop 4)
148− , benchIO "filter-take" (Ops.filterTake 4)
180+ , benchIOSink "filter-take" (Ops.filterTake 4)
149− , benchIO "filter-scan" (Ops.filterScan 4)
181+ , benchIOSink "filter-scan" (Ops.filterScan 4)
150− , benchIO "filter-map" (Ops.filterMap 4)
182+ , benchIOSink "filter-map" (Ops.filterMap 4)
151 ]
183 ]
152 , bgroup "iterated"
184 , bgroup "iterated"
153− [ benchSrcIO serially "mapM" Ops.iterateMapM
185+ [ benchIOSrc serially "mapM" Ops.iterateMapM
154− , benchSrcIO serially "scan(1/100)" Ops.iterateScan
186+ , benchIOSrc serially "scan(1/100)" Ops.iterateScan
155− , benchSrcIO serially "filterEven" Ops.iterateFilterEven
187+ , benchIOSrc serially "filterEven" Ops.iterateFilterEven
156− , benchSrcIO serially "takeAll" Ops.iterateTakeAll
188+ , benchIOSrc serially "takeAll" Ops.iterateTakeAll
157− , benchSrcIO serially "dropOne" Ops.iterateDropOne
189+ , benchIOSrc serially "dropOne" Ops.iterateDropOne
158− , benchSrcIO serially "dropWhileFalse" Ops.iterateDropWhileFalse
190+ , benchIOSrc serially "dropWhileFalse" Ops.iterateDropWhileFalse
159− , benchSrcIO serially "dropWhileTrue" Ops.iterateDropWhileTrue
191+ , benchIOSrc serially "dropWhileTrue" Ops.iterateDropWhileTrue
160 ]
192 ]
161 ]
193 ]
162 ]
194 ]
benchmark/LinearOps.hs+62−1
@@ -12,12 +12,14 @@
12module LinearOps where
12module LinearOps where
13
13
14import Control.Monad (when)
14import Control.Monad (when)
15+import Data.Functor.Identity (Identity)
15import Data.Maybe (fromJust)
16import Data.Maybe (fromJust)
16import Prelude
17import Prelude
17 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),
18 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),
18 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,
19 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,
19 maxBound, div)
20 maxBound, div)
20import qualified Prelude as P
21import qualified Prelude as P
22+import qualified GHC.Exts as GHC
21
23
22import qualified Streamly as S
24import qualified Streamly as S
23import qualified Streamly.Prelude as S
25import qualified Streamly.Prelude as S
@@ -107,6 +109,18 @@ sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n
107 then return Nothing
109 then return Nothing
108 else return (Just (return cnt, cnt + 1))
110 else return (Just (return cnt, cnt + 1))
109
111
112+-------------------------------------------------------------------------------
113+-- Pure stream generation
114+-------------------------------------------------------------------------------
115+
116+{-# INLINE sourceIsList #-}
117+sourceIsList :: Int -> S.SerialT Identity Int
118+sourceIsList n = GHC.fromList [n..n+value]
119+
120+{-# INLINE sourceIsString #-}
121+sourceIsString :: Int -> S.SerialT Identity P.Char
122+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
123+
110-------------------------------------------------------------------------------
124-------------------------------------------------------------------------------
111-- Elimination
125-- Elimination
112-------------------------------------------------------------------------------
126-------------------------------------------------------------------------------
@@ -128,7 +142,8 @@ toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]
128{-# INLINE elemIndex #-}
142{-# INLINE elemIndex #-}
129{-# INLINE foldl1' #-}
143{-# INLINE foldl1' #-}
130{-# INLINE foldr1 #-}
144{-# INLINE foldr1 #-}
131−last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1 :: Monad m => Stream m Int -> m (Maybe Int)
145+last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1
146+ :: Monad m => Stream m Int -> m (Maybe Int)
132
147
133{-# INLINE foldl' #-}
148{-# INLINE foldl' #-}
134{-# INLINE length #-}
149{-# INLINE length #-}
@@ -360,8 +375,17 @@ zipAsyncM src = do
360 r <- S.tail src
375 r <- S.tail src
361 let src1 = fromJust r
376 let src1 = fromJust r
362 transform (S.zipAsyncWithM (curry return) src src1)
377 transform (S.zipAsyncWithM (curry return) src src1)
378+
363concat _n = return ()
379concat _n = return ()
364
380
381+{-# INLINE eqBy #-}
382+eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
383+eqBy src = S.eqBy (==) src src
384+
385+{-# INLINE cmpBy #-}
386+cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
387+cmpBy src = S.cmpBy P.compare src src
388+
365-------------------------------------------------------------------------------
389-------------------------------------------------------------------------------
366-- Mixed Composition
390-- Mixed Composition
367-------------------------------------------------------------------------------
391-------------------------------------------------------------------------------
@@ -390,3 +414,40 @@ filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
390filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
414filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
391filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
415filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
392filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
416filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
417+
418+-------------------------------------------------------------------------------
419+-- Pure stream operations
420+-------------------------------------------------------------------------------
421+
422+{-# INLINE eqInstance #-}
423+eqInstance :: Stream Identity Int -> Bool
424+eqInstance src = src == src
425+
426+{-# INLINE eqInstanceNotEq #-}
427+eqInstanceNotEq :: Stream Identity Int -> Bool
428+eqInstanceNotEq src = src P./= src
429+
430+{-# INLINE ordInstance #-}
431+ordInstance :: Stream Identity Int -> Bool
432+ordInstance src = src P.< src
433+
434+{-# INLINE ordInstanceMin #-}
435+ordInstanceMin :: Stream Identity Int -> Stream Identity Int
436+ordInstanceMin src = P.min src src
437+
438+{-# INLINE showInstance #-}
439+showInstance :: Stream Identity Int -> P.String
440+showInstance src = P.showsPrec 0 src ""
441+
442+{-# INLINE showInstanceList #-}
443+showInstanceList :: Stream Identity Int -> P.String
444+showInstanceList src = P.showsPrec 0 (GHC.toList src P.++ [2..value]) ""
445+
446+{-# INLINE readInstance #-}
447+readInstance :: Stream Identity Int -> Stream Identity Int
448+readInstance src =
449+ let r = P.readsPrec 0 ("fromList [1"
450+ P.++ P.concat (P.replicate value ",1") P.++ "]")
451+ in case r of
452+ [(x,"")] -> src S.<> x
453+ _ -> P.error "readInstance: no parse"
benchmark/StreamDOps.hs+34−29
@@ -15,7 +15,7 @@ import Data.Maybe (isJust)
15import Prelude
15import Prelude
16 (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,
16 (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,
17 subtract, undefined, Maybe(..), not, mapM_, (>>=),
17 subtract, undefined, Maybe(..), not, mapM_, (>>=),
18− maxBound, fmap, odd)
18+ maxBound, fmap, odd, (==))
19import qualified Prelude as P
19import qualified Prelude as P
20
20
21import qualified Streamly.Streams.StreamD as S
21import qualified Streamly.Streams.StreamD as S
@@ -24,32 +24,6 @@ value, maxValue :: Int
24value = 100000
24value = 100000
25maxValue = value + 1000
25maxValue = value + 1000
26
26
27−-------------------------------------------------------------------------------
28−-- Benchmark ops
29−-------------------------------------------------------------------------------
30−
31−{-# INLINE uncons #-}
32−{-# INLINE nullTail #-}
33−{-# INLINE headTail #-}
34−{-# INLINE zip #-}
35−{-
36−{-# INLINE concat #-}
37−-}
38−uncons, nullTail, headTail, zip
39− -- concat,
40− :: Monad m
41− => Stream m Int -> m ()
42−
43−{-# INLINE toList #-}
44−toList :: Monad m => Stream m Int -> m [Int]
45−{-# INLINE foldl #-}
46−foldl :: Monad m => Stream m Int -> m Int
47−{-# INLINE last #-}
48−last :: Monad m => Stream m Int -> m (Maybe Int)
49−
50−{-# INLINE toNull #-}
51−toNull :: Monad m => Stream m Int -> m ()
52−
53-------------------------------------------------------------------------------
27-------------------------------------------------------------------------------
54-- Stream generation and elimination
28-- Stream generation and elimination
55-------------------------------------------------------------------------------
29-------------------------------------------------------------------------------
@@ -103,8 +77,17 @@ source = sourceUnfoldrM
103runStream :: Monad m => Stream m a -> m ()
77runStream :: Monad m => Stream m a -> m ()
104runStream = S.runStream
78runStream = S.runStream
105
79
80+{-# INLINE toNull #-}
81+toNull :: Monad m => Stream m Int -> m ()
106toNull = runStream
82toNull = runStream
107
83
84+{-# INLINE uncons #-}
85+{-# INLINE nullTail #-}
86+{-# INLINE headTail #-}
87+uncons, nullTail, headTail
88+ :: Monad m
89+ => Stream m Int -> m ()
90+
108uncons s = do
91uncons s = do
109 r <- S.uncons s
92 r <- S.uncons s
110 case r of
93 case r of
@@ -123,8 +106,16 @@ headTail s = do
123 h <- S.head s
106 h <- S.head s
124 when (isJust h) $ S.tail s >>= mapM_ headTail
107 when (isJust h) $ S.tail s >>= mapM_ headTail
125
108
109+{-# INLINE toList #-}
110+toList :: Monad m => Stream m Int -> m [Int]
126toList = S.toList
111toList = S.toList
112+
113+{-# INLINE foldl #-}
114+foldl :: Monad m => Stream m Int -> m Int
127foldl = S.foldl' (+) 0
115foldl = S.foldl' (+) 0
116+
117+{-# INLINE last #-}
118+last :: Monad m => Stream m Int -> m (Maybe Int)
128last = S.last
119last = S.last
129
120
130-------------------------------------------------------------------------------
121-------------------------------------------------------------------------------
@@ -236,8 +227,22 @@ iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
236-- Zipping and concat
227-- Zipping and concat
237-------------------------------------------------------------------------------
228-------------------------------------------------------------------------------
238
229
230+{-# INLINE eqBy #-}
231+eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
232+eqBy src = S.eqBy (==) src src
233+
234+{-# INLINE cmpBy #-}
235+cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
236+cmpBy src = S.cmpBy P.compare src src
237+
238+{-# INLINE zip #-}
239+zip :: Monad m => Stream m Int -> m ()
239−zip src = transform $ S.zipWith (,) src src
240+zip src = transform $ S.zipWith (,) src src
241+
242+{-
243+{-# INLINE concat #-}
240−-- concat _n = return ()
244+concat _n = return ()
245+-}
241
246
242-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
243-- Mixed Composition
248-- Mixed Composition
benchmark/StreamKOps.hs+3−3
@@ -19,7 +19,7 @@ import Prelude
19import qualified Prelude as P
19import qualified Prelude as P
20
20
21import qualified Streamly.Streams.StreamK as S
21import qualified Streamly.Streams.StreamK as S
22−import qualified Streamly.Streams.Prelude as S
22+import qualified Streamly.Streams.Prelude as SP
23import qualified Streamly.SVar as S
23import qualified Streamly.SVar as S
24
24
25value, maxValue :: Int
25value, maxValue :: Int
@@ -98,11 +98,11 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
98
98
99{-# INLINE sourceFoldMapWith #-}
99{-# INLINE sourceFoldMapWith #-}
100sourceFoldMapWith :: Int -> Stream m Int
100sourceFoldMapWith :: Int -> Stream m Int
101−sourceFoldMapWith n = S.foldMapWith S.serial S.yield [n..n+value]
101+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
102
102
103{-# INLINE sourceFoldMapWithM #-}
103{-# INLINE sourceFoldMapWithM #-}
104sourceFoldMapWithM :: Monad m => Int -> Stream m Int
104sourceFoldMapWithM :: Monad m => Int -> Stream m Int
105−sourceFoldMapWithM n = S.foldMapWith S.serial (S.yieldM . return) [n..n+value]
105+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
106
106
107{-# INLINE source #-}
107{-# INLINE source #-}
108source :: S.MonadAsync m => Int -> Stream m Int
108source :: S.MonadAsync m => Int -> Stream m Int
src/Streamly/Prelude.hs+29−35
@@ -51,6 +51,7 @@ module Streamly.Prelude
51 K.nil
51 K.nil
52 , K.cons
52 , K.cons
53 , (K..:)
53 , (K..:)
54+
54 , consM
55 , consM
55 , (|:)
56 , (|:)
56 , yield
57 , yield
@@ -89,7 +90,7 @@ module Streamly.Prelude
89 -- ** Generate From
90 -- ** Generate From
90 -- | Convert an input structure, container or source into a stream. All of
91 -- | Convert an input structure, container or source into a stream. All of
91 -- these can be expressed in terms of primitives.
92 -- these can be expressed in terms of primitives.
92− , fromList
93+ , P.fromList
93 , fromListM
94 , fromListM
94 , K.fromFoldable
95 , K.fromFoldable
95 , fromFoldableM
96 , fromFoldableM
@@ -136,6 +137,8 @@ module Streamly.Prelude
136 , any
137 , any
137 , and
138 , and
138 , or
139 , or
140+ , eqBy
141+ , cmpBy
139
142
140 -- Full folds - need to go through all elements
143 -- Full folds - need to go through all elements
141 , length
144 , length
@@ -233,9 +236,12 @@ import qualified System.IO as IO
233
236
234import Streamly.SVar (MonadAsync, defState, rstState)
237import Streamly.SVar (MonadAsync, defState, rstState)
235import Streamly.Streams.Combinators (maxYields)
238import Streamly.Streams.Combinators (maxYields)
239+import Streamly.Streams.Prelude (fromStreamS, toStreamS)
240+import Streamly.Streams.StreamD (fromStreamD, toStreamD)
236import Streamly.Streams.StreamK (IsStream(..))
241import Streamly.Streams.StreamK (IsStream(..))
237import Streamly.Streams.Serial (SerialT)
242import Streamly.Streams.Serial (SerialT)
238
243
244+import qualified Streamly.Streams.Prelude as P
239import qualified Streamly.Streams.StreamK as K
245import qualified Streamly.Streams.StreamK as K
240import qualified Streamly.Streams.StreamD as D
246import qualified Streamly.Streams.StreamD as D
241import qualified Streamly.Streams.Zip as Z
247import qualified Streamly.Streams.Zip as Z
@@ -249,27 +255,6 @@ import qualified Streamly.Streams.StreamD as S
249
255
250import qualified Streamly.Streams.Serial as Serial
256import qualified Streamly.Streams.Serial as Serial
251
257
252−------------------------------------------------------------------------------
253−-- Conversion to and from direct style stream
254−------------------------------------------------------------------------------
255−
256−-- These definitions are dependent on what is imported as S
257−{-# INLINE fromStreamS #-}
258−fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a
259−fromStreamS = fromStream . S.toStreamK
260−
261−{-# INLINE toStreamS #-}
262−toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a
263−toStreamS = S.fromStreamK . toStream
264−
265−{-# INLINE fromStreamD #-}
266−fromStreamD :: (IsStream t, Monad m) => D.Stream m a -> t m a
267−fromStreamD = fromStream . D.toStreamK
268−
269−{-# INLINE toStreamD #-}
270−toStreamD :: (IsStream t, Monad m) => t m a -> D.Stream m a
271−toStreamD = D.fromStreamK . toStream
272−
273------------------------------------------------------------------------------
258------------------------------------------------------------------------------
274-- Deconstruction
259-- Deconstruction
275------------------------------------------------------------------------------
260------------------------------------------------------------------------------
@@ -460,17 +445,6 @@ iterateM step = go
460-- Conversions
445-- Conversions
461------------------------------------------------------------------------------
446------------------------------------------------------------------------------
462
447
463−-- | Construct a stream from a list containing pure values. More efficient list
464−-- specific implementation of 'K.fromFoldable' as it works well with fusion
465−-- optimization.
466−--
467−-- @since 0.4.0
468−{-# INLINE_EARLY fromList #-}
469−fromList :: (Monad m, IsStream t) => [a] -> t m a
470−fromList = fromStreamS . S.fromList
471−{-# RULES "fromList fallback to StreamK" [1]
472− forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}
473−
474-- | Construct a stream from a list containing monadic actions. More efficient
448-- | Construct a stream from a list containing monadic actions. More efficient
475-- list specific implementation of 'fromFoldableM' especially for serial
449-- list specific implementation of 'fromFoldableM' especially for serial
476-- streams as it works well with fusion optimization.
450-- streams as it works well with fusion optimization.
@@ -579,7 +553,7 @@ foldl = foldx
579-- @since 0.2.0
553-- @since 0.2.0
580{-# INLINE foldl' #-}
554{-# INLINE foldl' #-}
581foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b
555foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b
582−foldl' step begin m = S.foldl' step begin $ toStreamS m
556+foldl' = P.foldl'
583
557
584-- | Strict left fold, for non-empty streams, using first element as the
558-- | Strict left fold, for non-empty streams, using first element as the
585-- starting value. Returns 'Nothing' if the stream is empty.
559-- starting value. Returns 'Nothing' if the stream is empty.
@@ -798,7 +772,7 @@ mapM_ f m = S.mapM_ f $ toStreamS m
798-- @since 0.1.0
772-- @since 0.1.0
799{-# INLINE toList #-}
773{-# INLINE toList #-}
800toList :: Monad m => SerialT m a -> m [a]
774toList :: Monad m => SerialT m a -> m [a]
801−toList m = S.toList $ toStreamS m
775+toList = P.toList
802
776
803-- | Write a stream of Strings to an IO Handle.
777-- | Write a stream of Strings to an IO Handle.
804--
778--
@@ -1039,3 +1013,23 @@ zipWithM f m1 m2 = fromStreamS $ S.zipWithM f (toStreamS m1) (toStreamS m2)
1039{-# INLINABLE zipWith #-}
1013{-# INLINABLE zipWith #-}
1040zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c
1014zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c
1041zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)
1015zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)
1016+
1017+------------------------------------------------------------------------------
1018+-- Comparison
1019+------------------------------------------------------------------------------
1020+
1021+-- | Compare two streams for equality using a equality function.
1022+--
1023+-- @since 0.5.3
1024+{-# INLINABLE eqBy #-}
1025+eqBy :: Monad m => (a -> b -> Bool) -> SerialT m a -> SerialT m b -> m Bool
1026+eqBy = P.eqBy
1027+
1028+-- | Compare two streams using a comparison function.
1029+--
1030+-- @since 0.5.3
1031+{-# INLINABLE cmpBy #-}
1032+cmpBy
1033+ :: Monad m
1034+ => (a -> b -> Ordering) -> SerialT m a -> SerialT m b -> m Ordering
1035+cmpBy = P.cmpBy
src/Streamly/Streams/Prelude.hs+97−1
@@ -1,3 +1,11 @@
1+{-# LANGUAGE CPP #-}
2+
3+#if __GLASGOW_HASKELL__ >= 800
4+{-# OPTIONS_GHC -Wno-orphans #-}
5+#endif
6+
7+#include "inline.hs"
8+
1-- |
9-- |
2-- Module : Streamly.Streams.Prelude
10-- Module : Streamly.Streams.Prelude
3-- Copyright : (c) 2017 Harendra Kumar
11-- Copyright : (c) 2017 Harendra Kumar
@@ -10,15 +18,103 @@
10--
18--
11module Streamly.Streams.Prelude
19module Streamly.Streams.Prelude
12 (
20 (
21+ -- * Stream Conversion
22+ fromStreamS
23+ , toStreamS
24+
25+ -- * Conversion operations
26+ , fromList
27+ , toList
28+
29+ -- * Fold operations
30+ , foldl'
31+
32+ -- * Zip style operations
33+ , eqBy
34+ , cmpBy
35+
13 -- * Fold Utilities
36 -- * Fold Utilities
14− foldWith
37+ , foldWith
15 , foldMapWith
38 , foldMapWith
16 , forEachWith
39 , forEachWith
17 )
40 )
18where
41where
19
42
43+#ifdef USE_STREAMK_ONLY
44+import qualified Streamly.Streams.StreamK as S
45+#else
46+import qualified Streamly.Streams.StreamD as S
47+#endif
48+
20import Streamly.Streams.StreamK (IsStream(..))
49import Streamly.Streams.StreamK (IsStream(..))
21import qualified Streamly.Streams.StreamK as K
50import qualified Streamly.Streams.StreamK as K
51+import qualified Streamly.Streams.StreamD as D
52+
53+------------------------------------------------------------------------------
54+-- Conversion to and from direct style stream
55+------------------------------------------------------------------------------
56+
57+-- These definitions are dependent on what is imported as S
58+{-# INLINE fromStreamS #-}
59+fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a
60+fromStreamS = fromStream . S.toStreamK
61+
62+{-# INLINE toStreamS #-}
63+toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a
64+toStreamS = S.fromStreamK . toStream
65+
66+------------------------------------------------------------------------------
67+-- Conversions
68+------------------------------------------------------------------------------
69+
70+-- | Construct a stream from a list containing pure values. More efficient list
71+-- specific implementation of 'K.fromFoldable' as it works well with fusion
72+-- optimization.
73+--
74+-- @since 0.4.0
75+{-# INLINE_EARLY fromList #-}
76+fromList :: (Monad m, IsStream t) => [a] -> t m a
77+fromList = fromStreamS . S.fromList
78+{-# RULES "fromList fallback to StreamK" [1]
79+ forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}
80+
81+-- | Convert a stream into a list in the underlying monad.
82+--
83+-- @since 0.1.0
84+{-# INLINE toList #-}
85+toList :: (Monad m, IsStream t) => t m a -> m [a]
86+toList m = S.toList $ toStreamS m
87+
88+------------------------------------------------------------------------------
89+-- Folds
90+------------------------------------------------------------------------------
91+
92+-- | Strict left associative fold.
93+--
94+-- @since 0.2.0
95+{-# INLINE foldl' #-}
96+foldl' :: (Monad m, IsStream t) => (b -> a -> b) -> b -> t m a -> m b
97+foldl' step begin m = S.foldl' step begin $ toStreamS m
98+
99+------------------------------------------------------------------------------
100+-- Comparison
101+------------------------------------------------------------------------------
102+
103+-- | Compare two streams for equality
104+--
105+-- @since 0.5.3
106+{-# INLINE eqBy #-}
107+eqBy :: (IsStream t, Monad m) => (a -> b -> Bool) -> t m a -> t m b -> m Bool
108+eqBy f m1 m2 = D.eqBy f (D.toStreamD m1) (D.toStreamD m2)
109+
110+-- | Compare two streams
111+--
112+-- @since 0.5.3
113+{-# INLINE cmpBy #-}
114+cmpBy
115+ :: (IsStream t, Monad m)
116+ => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering
117+cmpBy f m1 m2 = D.cmpBy f (D.toStreamD m1) (D.toStreamD m2)
22
118
23------------------------------------------------------------------------------
119------------------------------------------------------------------------------
24-- Fold Utilities
120-- Fold Utilities
src/Streamly/Streams/Serial.hs+72−1
@@ -6,6 +6,7 @@
6{-# LANGUAGE GeneralizedNewtypeDeriving#-}
6{-# LANGUAGE GeneralizedNewtypeDeriving#-}
7{-# LANGUAGE InstanceSigs #-}
7{-# LANGUAGE InstanceSigs #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE UndecidableInstances #-} -- XXX
10{-# LANGUAGE UndecidableInstances #-} -- XXX
10
11
11-- |
12-- |
@@ -42,6 +43,7 @@ module Streamly.Streams.Serial
42 )
43 )
43where
44where
44
45
46+import Control.DeepSeq (NFData(..), NFData1(..), rnf1)
45import Control.Monad (ap)
47import Control.Monad (ap)
46import Control.Monad.Base (MonadBase(..), liftBaseDefault)
48import Control.Monad.Base (MonadBase(..), liftBaseDefault)
47import Control.Monad.Catch (MonadThrow, throwM)
49import Control.Monad.Catch (MonadThrow, throwM)
@@ -50,11 +52,16 @@ import Control.Monad.IO.Class (MonadIO(..))
50import Control.Monad.Reader.Class (MonadReader(..))
52import Control.Monad.Reader.Class (MonadReader(..))
51import Control.Monad.State.Class (MonadState(..))
53import Control.Monad.State.Class (MonadState(..))
52import Control.Monad.Trans.Class (MonadTrans(lift))
54import Control.Monad.Trans.Class (MonadTrans(lift))
55+import Data.Functor.Identity (Identity, runIdentity)
53import Data.Semigroup (Semigroup(..))
56import Data.Semigroup (Semigroup(..))
57+import GHC.Exts (IsList(..), IsString(..))
58+import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
59+ readListPrecDefault)
54−import Prelude hiding (map, mapM)
60+import Prelude hiding (map, mapM, String)
55
61
56import Streamly.SVar (rstState)
62import Streamly.SVar (rstState)
57import Streamly.Streams.StreamK (IsStream(..), adapt, Stream(..))
63import Streamly.Streams.StreamK (IsStream(..), adapt, Stream(..))
64+import qualified Streamly.Streams.Prelude as P
58import qualified Streamly.Streams.StreamK as K
65import qualified Streamly.Streams.StreamK as K
59import qualified Streamly.Streams.StreamD as D
66import qualified Streamly.Streams.StreamD as D
60
67
@@ -343,3 +350,67 @@ instance Monad m => Monad (WSerialT m) where
343
350
344MONAD_APPLICATIVE_INSTANCE(WSerialT,)
351MONAD_APPLICATIVE_INSTANCE(WSerialT,)
345MONAD_COMMON_INSTANCES(WSerialT,)
352MONAD_COMMON_INSTANCES(WSerialT,)
353+
354+------------------------------------------------------------------------------
355+-- Lists
356+------------------------------------------------------------------------------
357+
358+-- Serial streams can act like regular lists using the Identity monad
359+
360+-- XXX Show instance is 10x slower compared to read, we can do much better.
361+-- The list show instance itself is really slow.
362+
363+-- XXX The default definitions of "<" in the Ord instance etc. do not perform
364+-- well, because they do not get inlined. Need to add INLINE in Ord class in
365+-- base?
366+
367+#define LIST_INSTANCES(STREAM) \
368+instance IsList (STREAM Identity a) where { \
369+ type (Item (STREAM Identity a)) = a; \
370+ {-# INLINE fromList #-}; \
371+ fromList = P.fromList; \
372+ {-# INLINE toList #-}; \
373+ toList = runIdentity . P.toList }; \
374+ \
375+instance Eq a => Eq (STREAM Identity a) where { \
376+ {-# INLINE (==) #-}; \
377+ (==) xs ys = runIdentity $ P.eqBy (==) xs ys }; \
378+ \
379+instance Ord a => Ord (STREAM Identity a) where { \
380+ {-# INLINE compare #-}; \
381+ compare xs ys = runIdentity $ P.cmpBy compare xs ys; \
382+ {-# INLINE (<) #-}; \
383+ x < y = case compare x y of { LT -> True; _ -> False }; \
384+ {-# INLINE (<=) #-}; \
385+ x <= y = case compare x y of { GT -> False; _ -> True }; \
386+ {-# INLINE (>) #-}; \
387+ x > y = case compare x y of { GT -> True; _ -> False }; \
388+ {-# INLINE (>=) #-}; \
389+ x >= y = case compare x y of { LT -> False; _ -> True }; \
390+ {-# INLINE max #-}; \
391+ max x y = if x <= y then y else x; \
392+ {-# INLINE min #-}; \
393+ min x y = if x <= y then x else y; }; \
394+ \
395+instance Show a => Show (STREAM Identity a) where { \
396+ showsPrec p dl = showParen (p > 10) $ \
397+ showString "fromList " . shows (toList dl) }; \
398+ \
399+instance Read a => Read (STREAM Identity a) where { \
400+ readPrec = parens $ prec 10 $ do { \
401+ Ident "fromList" <- lexP; \
402+ dl <- readPrec; \
403+ return (fromList dl) }; \
404+ readListPrec = readListPrecDefault }; \
405+ \
406+instance (a ~ Char) => IsString (STREAM Identity a) where { \
407+ {-# INLINE fromString #-}; \
408+ fromString = P.fromList }; \
409+ \
410+instance NFData a => NFData (STREAM Identity a) where { rnf = rnf1 }; \
411+instance NFData1 (STREAM Identity) where { \
412+ {-# INLINE liftRnf #-}; \
413+ liftRnf r = runIdentity . P.foldl' (\_ x -> r x) () }
414+
415+LIST_INSTANCES(SerialT)
416+LIST_INSTANCES(WSerialT)
src/Streamly/Streams/StreamD.hs+75
@@ -61,6 +61,7 @@ module Streamly.Streams.StreamD
61 , fromList
61 , fromList
62 , fromListM
62 , fromListM
63 , fromStreamK
63 , fromStreamK
64+ , fromStreamD
64
65
65 -- * Elimination
66 -- * Elimination
66 -- ** General Folds
67 -- ** General Folds
@@ -89,6 +90,7 @@ module Streamly.Streams.StreamD
89 -- | Transform a stream into another type.
90 -- | Transform a stream into another type.
90 , toList
91 , toList
91 , toStreamK
92 , toStreamK
93+ , toStreamD
92
94
93 -- * Transformation
95 -- * Transformation
94 -- ** By folding (scans)
96 -- ** By folding (scans)
@@ -116,6 +118,10 @@ module Streamly.Streams.StreamD
116 -- * Zipping
118 -- * Zipping
117 , zipWith
119 , zipWith
118 , zipWithM
120 , zipWithM
121+
122+ -- * Comparisions
123+ , eqBy
124+ , cmpBy
119 )
125 )
120where
126where
121
127
@@ -292,6 +298,10 @@ fromStreamK = Stream step
292 yieldk a r = return $ Yield a r
298 yieldk a r = return $ Yield a r
293 in K.unStream m1 gst stop single yieldk
299 in K.unStream m1 gst stop single yieldk
294
300
301+{-# INLINE toStreamD #-}
302+toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a
303+toStreamD = fromStreamK . K.toStream
304+
295------------------------------------------------------------------------------
305------------------------------------------------------------------------------
296-- Elimination by Folds
306-- Elimination by Folds
297------------------------------------------------------------------------------
307------------------------------------------------------------------------------
@@ -501,6 +511,10 @@ toStreamK (Stream step state) = go state
501 forall s. fromStreamK (toStreamK s) = s #-}
511 forall s. fromStreamK (toStreamK s) = s #-}
502#endif
512#endif
503
513
514+{-# INLINE fromStreamD #-}
515+fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a
516+fromStreamD = K.fromStream . toStreamK
517+
504------------------------------------------------------------------------------
518------------------------------------------------------------------------------
505-- Transformation by Folding (Scans)
519-- Transformation by Folding (Scans)
506------------------------------------------------------------------------------
520------------------------------------------------------------------------------
@@ -708,6 +722,67 @@ zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)
708zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
722zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
709zipWith f = zipWithM (\a b -> return (f a b))
723zipWith f = zipWithM (\a b -> return (f a b))
710
724
725+------------------------------------------------------------------------------
726+-- Comparisions
727+------------------------------------------------------------------------------
728+
729+{-# INLINE_NORMAL eqBy #-}
730+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool
731+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
732+ where
733+ eq_loop0 !_ s1 s2 = do
734+ r <- step1 defState s1
735+ case r of
736+ Yield x s1' -> eq_loop1 SPEC x s1' s2
737+ Skip s1' -> eq_loop0 SPEC s1' s2
738+ Stop -> eq_null s2
739+
740+ eq_loop1 !_ x s1 s2 = do
741+ r <- step2 defState s2
742+ case r of
743+ Yield y s2'
744+ | eq x y -> eq_loop0 SPEC s1 s2'
745+ | otherwise -> return False
746+ Skip s2' -> eq_loop1 SPEC x s1 s2'
747+ Stop -> return False
748+
749+ eq_null s2 = do
750+ r <- step2 defState s2
751+ case r of
752+ Yield _ _ -> return False
753+ Skip s2' -> eq_null s2'
754+ Stop -> return True
755+
756+-- | Compare two streams lexicographically
757+{-# INLINE_NORMAL cmpBy #-}
758+cmpBy
759+ :: Monad m
760+ => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
761+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
762+ where
763+ cmp_loop0 !_ s1 s2 = do
764+ r <- step1 defState s1
765+ case r of
766+ Yield x s1' -> cmp_loop1 SPEC x s1' s2
767+ Skip s1' -> cmp_loop0 SPEC s1' s2
768+ Stop -> cmp_null s2
769+
770+ cmp_loop1 !_ x s1 s2 = do
771+ r <- step2 defState s2
772+ case r of
773+ Yield y s2' -> case x `cmp` y of
774+ EQ -> cmp_loop0 SPEC s1 s2'
775+ c -> return c
776+ Skip s2' -> cmp_loop1 SPEC x s1 s2'
777+ Stop -> return GT
778+
779+ cmp_null s2 = do
780+ r <- step2 defState s2
781+ case r of
782+ Yield _ _ -> return LT
783+ Skip s2' -> cmp_null s2'
784+ Stop -> return EQ
785+
711------------------------------------------------------------------------------
786------------------------------------------------------------------------------
712-- Instances
787-- Instances
713------------------------------------------------------------------------------
788------------------------------------------------------------------------------
stack-7.10.yaml+1
@@ -12,6 +12,7 @@ extra-deps:
12 - SDL-0.6.5.1
12 - SDL-0.6.5.1
13 - gauge-0.2.4
13 - gauge-0.2.4
14 - basement-0.0.7
14 - basement-0.0.7
15+ - deepseq-1.4.4.0
15flags: {}
16flags: {}
16extra-package-dbs: []
17extra-package-dbs: []
17# For mac ports installed SDL library on Mac OS X
18# For mac ports installed SDL library on Mac OS X
stack-8.0.yaml+1
@@ -8,6 +8,7 @@ extra-deps:
8 - SDL-0.6.5.1
8 - SDL-0.6.5.1
9 - gauge-0.2.4
9 - gauge-0.2.4
10 - basement-0.0.4
10 - basement-0.0.4
11+ - deepseq-1.4.4.0
11flags: {}
12flags: {}
12extra-package-dbs: []
13extra-package-dbs: []
13rebuild-ghc-options: true
14rebuild-ghc-options: true
streamly.cabal+30−5
@@ -172,6 +172,7 @@ library
172
172
173 build-depends: base >= 4.8 && < 5
173 build-depends: base >= 4.8 && < 5
174 , ghc-prim >= 0.2 && < 0.6
174 , ghc-prim >= 0.2 && < 0.6
175+ , deepseq >= 1.4.3 && < 1.5
175 , containers >= 0.5 && < 0.7
176 , containers >= 0.5 && < 0.7
176 , heaps >= 0.3 && < 0.4
177 , heaps >= 0.3 && < 0.4
177
178
@@ -225,6 +226,30 @@ test-suite test
225 , exceptions >= 0.8 && < 0.11
226 , exceptions >= 0.8 && < 0.11
226 default-language: Haskell2010
227 default-language: Haskell2010
227
228
229+test-suite pure-streams
230+ type: exitcode-stdio-1.0
231+ main-is: PureStreams.hs
232+ hs-source-dirs: test
233+ ghc-options: -O0 -Wall -threaded -with-rtsopts=-N -fno-ignore-asserts
234+ if flag(dev)
235+ cpp-options: -DDEVBUILD
236+ ghc-options: -Wmissed-specialisations
237+ -Wall-missed-specialisations
238+ if impl(ghc >= 8.0)
239+ ghc-options: -Wcompat
240+ -Wunrecognised-warning-flags
241+ -Widentities
242+ -Wincomplete-record-updates
243+ -Wincomplete-uni-patterns
244+ -Wredundant-constraints
245+ -Wnoncanonical-monad-instances
246+ -Wnoncanonical-monadfail-instances
247+ build-depends:
248+ streamly
249+ , base >= 4.8 && < 5
250+ , hspec >= 2.0 && < 3
251+ default-language: Haskell2010
252+
228test-suite properties
253test-suite properties
229 type: exitcode-stdio-1.0
254 type: exitcode-stdio-1.0
230 main-is: Prop.hs
255 main-is: Prop.hs
@@ -329,7 +354,7 @@ benchmark linear
329 build-depends:
354 build-depends:
330 streamly
355 streamly
331 , base >= 4.8 && < 5
356 , base >= 4.8 && < 5
332− , deepseq >= 1.4.0 && < 1.5
357+ , deepseq >= 1.4.3 && < 1.5
333 , random >= 1.0 && < 2.0
358 , random >= 1.0 && < 2.0
334 , gauge >= 0.2.4 && < 0.3
359 , gauge >= 0.2.4 && < 0.3
335
360
@@ -357,7 +382,7 @@ benchmark linear-async
357 build-depends:
382 build-depends:
358 streamly
383 streamly
359 , base >= 4.8 && < 5
384 , base >= 4.8 && < 5
360− , deepseq >= 1.4.0 && < 1.5
385+ , deepseq >= 1.4.3 && < 1.5
361 , random >= 1.0 && < 2.0
386 , random >= 1.0 && < 2.0
362 , gauge >= 0.2.4 && < 0.3
387 , gauge >= 0.2.4 && < 0.3
363
388
@@ -384,7 +409,7 @@ benchmark linear-rate
384 build-depends:
409 build-depends:
385 streamly
410 streamly
386 , base >= 4.8 && < 5
411 , base >= 4.8 && < 5
387− , deepseq >= 1.4.0 && < 1.5
412+ , deepseq >= 1.4.3 && < 1.5
388 , random >= 1.0 && < 2.0
413 , random >= 1.0 && < 2.0
389 , gauge >= 0.2.4 && < 0.3
414 , gauge >= 0.2.4 && < 0.3
390
415
@@ -411,7 +436,7 @@ benchmark nested
411 build-depends:
436 build-depends:
412 streamly
437 streamly
413 , base >= 4.8 && < 5
438 , base >= 4.8 && < 5
414− , deepseq >= 1.4.0 && < 1.5
439+ , deepseq >= 1.4.3 && < 1.5
415 , random >= 1.0 && < 2.0
440 , random >= 1.0 && < 2.0
416 , gauge >= 0.2.4 && < 0.3
441 , gauge >= 0.2.4 && < 0.3
417
442
@@ -454,7 +479,7 @@ benchmark base
454 buildable: True
479 buildable: True
455 build-depends:
480 build-depends:
456 base >= 4.8 && < 5
481 base >= 4.8 && < 5
457− , deepseq >= 1.4.0 && < 1.5
482+ , deepseq >= 1.4.3 && < 1.5
458 , random >= 1.0 && < 2.0
483 , random >= 1.0 && < 2.0
459 , gauge >= 0.2.4 && < 0.3
484 , gauge >= 0.2.4 && < 0.3
460
485
test/PureStreams.hsnew file+87
@@ -0,0 +1,87 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE OverloadedLists #-}
5+{-# LANGUAGE PatternSynonyms #-}
6+{-# LANGUAGE ViewPatterns #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+
9+module Main (main) where
10+
11+import Test.Hspec
12+import Data.Functor.Identity
13+import qualified GHC.Exts as GHC
14+import Prelude hiding (String)
15+
16+import Streamly
17+import qualified Streamly.Prelude as S
18+
19+type List = SerialT Identity
20+type String = List Char
21+
22+------------------------------------------------------------------------------
23+-- Patterns
24+------------------------------------------------------------------------------
25+
26+-- | A pattern that matches an empty pure stream.
27+pattern Nil :: SerialT Identity a
28+pattern Nil <- (runIdentity . S.null -> True) where
29+ Nil = S.nil
30+
31+-- | A pattern that deconstructs a pure stream into its head and tail.
32+pattern Cons :: a -> SerialT Identity a -> SerialT Identity a
33+pattern Cons x xs <- (runIdentity . S.uncons -> Just (x, xs)) where
34+ Cons x xs = S.cons x xs
35+
36+main :: IO ()
37+main = hspec $ do
38+ -- Need type annotation to resolve the monad ambiguity
39+ -- Use toList or runIdentity . S.toList to convert to Haskell lists
40+
41+ it "overloaded lists" $ do
42+ ([1..3] :: Main.List Int) `shouldBe` S.fromList [1..3]
43+ GHC.toList ([1..3] :: Main.List Int) `shouldBe` [1..3]
44+
45+ it "overloaded strings" $ do
46+ ("hello" :: Main.String) `shouldBe` S.fromList "hello"
47+
48+ it "pattern match constructs a list" $ do
49+ ('x' `Cons` Nil) `shouldBe` ('x' `S.cons` S.nil :: Main.String)
50+ (1 `Cons` [2] :: Main.List Int) `shouldBe` S.fromList [1,2]
51+
52+ it "pattern match on empty string" $
53+ case "" :: Main.String of
54+ Nil -> return ()
55+ _ -> expectationFailure "not reached"
56+
57+ it "pattern matches on singleton string" $
58+ case "a" :: Main.String of
59+ Cons x Nil -> x `shouldBe` 'a'
60+ _ -> expectationFailure "not reached"
61+
62+ it "pattern matches on non-empty string" $
63+ case "hello" <> "world" :: Main.String of
64+ Cons x1 (Cons x2 xs) -> do
65+ x1 `shouldBe` 'h'
66+ x2 `shouldBe` 'e'
67+ xs `shouldBe` "lloworld"
68+ _ -> expectationFailure "not reached"
69+
70+ it "pattern match on non-empty list" $
71+ case S.map (+1) [1..10] :: Main.List Int of
72+ Cons x xs -> do
73+ x `shouldBe` 2
74+ xs `shouldBe` [3..11]
75+ _ -> expectationFailure "not reached"
76+
77+ it "Shows as string" $ do
78+ show (S.fromList [1..3] :: Main.List Int) `shouldBe` "fromList [1,2,3]"
79+
80+ it "Reads from a string" $ do
81+ (read "fromList [1,2,3]" :: Main.List Int) `shouldBe` S.fromList [1..3]
82+
83+ it "Eq instance" $ do
84+ (S.fromList [1,2,3] :: Main.List Int) == S.fromList [1,2,3] `shouldBe` True
85+
86+ it "Ord instance" $ do
87+ (S.fromList [1,2,3] :: Main.List Int) > S.fromList [1,2,1] `shouldBe` True