git.iko.soy/streamly
on master help sign in
Add nested unfold operations and benchmarks
4810c8eHarendra Kumar
benchmark/NestedUnfold.hsnew file+32
compare with master
unifiedsplit
@@ -0,0 +1,32 @@
1+-- |
2+-- Module : NestedUnfold
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Control.DeepSeq (NFData)
9+import System.Random (randomRIO)
10+
11+import qualified NestedUnfoldOps as Ops
12+
13+import Gauge
14+
15+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
16+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
17+
18+main :: IO ()
19+main =
20+ defaultMain
21+ [ bgroup "unfold"
22+ [ benchIO "toNull" $ Ops.toNull
23+ , benchIO "toNull3" $ Ops.toNull3
24+ , benchIO "concat" $ Ops.concat
25+ , benchIO "toList" $ Ops.toList
26+ , benchIO "toListSome" $ Ops.toListSome
27+ , benchIO "filterAllOut" $ Ops.filterAllOut
28+ , benchIO "filterAllIn" $ Ops.filterAllIn
29+ , benchIO "filterSome" $ Ops.filterSome
30+ , benchIO "breakAfterSome" $ Ops.breakAfterSome
31+ ]
32+ ]
benchmark/NestedUnfoldOps.hsnew file+128
@@ -0,0 +1,128 @@
1+-- |
2+-- Module : NestedUnfoldOps
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+module NestedUnfoldOps where
9+
10+import Control.Monad.IO.Class (MonadIO (..))
11+import Streamly.Internal.Data.Unfold (Unfold)
12+
13+import qualified Streamly.Internal.Data.Unfold as UF
14+import qualified Streamly.Internal.Data.Fold as FL
15+
16+linearCount :: Int
17+linearCount = 100000
18+
19+-- n * (n + 1) / 2 == linearCount
20+concatCount :: Int
21+concatCount = 450
22+
23+-- double nested loop
24+nestedCount2 :: Int
25+nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
26+
27+-- triple nested loop
28+nestedCount3 :: Int
29+nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
30+
31+-------------------------------------------------------------------------------
32+-- Stream generation and elimination
33+-------------------------------------------------------------------------------
34+
35+-- generate numbers up to the argument value
36+{-# INLINE source #-}
37+source :: Monad m => Int -> Unfold m Int Int
38+source n = UF.enumerateFromToIntegral n
39+
40+-------------------------------------------------------------------------------
41+-- Benchmark ops
42+-------------------------------------------------------------------------------
43+
44+{-# INLINE toNull #-}
45+toNull :: MonadIO m => Int -> m ()
46+toNull start = do
47+ let end = start + nestedCount2
48+ UF.fold
49+ (UF.map (\(x, y) -> x + y)
50+ $ UF.outerProduct (source end) (source end))
51+ FL.drain (start, start)
52+
53+{-# INLINE toNull3 #-}
54+toNull3 :: MonadIO m => Int -> m ()
55+toNull3 start = do
56+ let end = start + nestedCount3
57+ UF.fold
58+ (UF.map (\(x, y) -> x + y)
59+ $ UF.outerProduct (source end)
60+ ((UF.map (\(x, y) -> x + y)
61+ $ UF.outerProduct (source end) (source end))))
62+ FL.drain (start, (start, start))
63+
64+{-# INLINE concat #-}
65+concat :: MonadIO m => Int -> m ()
66+concat start = do
67+ let end = start + concatCount
68+ UF.fold
69+ (UF.concat (source end) (source end))
70+ FL.drain start
71+
72+{-# INLINE toList #-}
73+toList :: MonadIO m => Int -> m [Int]
74+toList start = do
75+ let end = start + nestedCount2
76+ UF.fold
77+ (UF.map (\(x, y) -> x + y)
78+ $ UF.outerProduct (source end) (source end))
79+ FL.toList (start, start)
80+
81+{-# INLINE toListSome #-}
82+toListSome :: MonadIO m => Int -> m [Int]
83+toListSome start = do
84+ let end = start + nestedCount2
85+ UF.fold
86+ (UF.take 1000 $ (UF.map (\(x, y) -> x + y)
87+ $ UF.outerProduct (source end) (source end)))
88+ FL.toList (start, start)
89+
90+{-# INLINE filterAllOut #-}
91+filterAllOut :: MonadIO m => Int -> m ()
92+filterAllOut start = do
93+ let end = start + nestedCount2
94+ UF.fold
95+ (UF.filter (< 0)
96+ $ UF.map (\(x, y) -> x + y)
97+ $ UF.outerProduct (source end) (source end))
98+ FL.drain (start, start)
99+
100+{-# INLINE filterAllIn #-}
101+filterAllIn :: MonadIO m => Int -> m ()
102+filterAllIn start = do
103+ let end = start + nestedCount2
104+ UF.fold
105+ (UF.filter (> 0)
106+ $ UF.map (\(x, y) -> x + y)
107+ $ UF.outerProduct (source end) (source end))
108+ FL.drain (start, start)
109+
110+{-# INLINE filterSome #-}
111+filterSome :: MonadIO m => Int -> m ()
112+filterSome start = do
113+ let end = start + nestedCount2
114+ UF.fold
115+ (UF.filter (> 1100000)
116+ $ UF.map (\(x, y) -> x + y)
117+ $ UF.outerProduct (source end) (source end))
118+ FL.drain (start, start)
119+
120+{-# INLINE breakAfterSome #-}
121+breakAfterSome :: MonadIO m => Int -> m ()
122+breakAfterSome start = do
123+ let end = start + nestedCount2
124+ UF.fold
125+ (UF.takeWhile (<= 1100000)
126+ $ UF.map (\(x, y) -> x + y)
127+ $ UF.outerProduct (source end) (source end))
128+ FL.drain (start, start)
src/Streamly/Internal/Data/Unfold.hs+269−1
@@ -39,6 +39,14 @@
39-- these are stream consumers that reduce the stream to a single value, these
39-- these are stream consumers that reduce the stream to a single value, these
40-- consumers can be composed such that a stream can be split over multiple
40-- consumers can be composed such that a stream can be split over multiple
41-- consumers.
41-- consumers.
42+--
43+-- Performance:
44+--
45+-- Composing a tree or graph of computations with unfolds can be much more
46+-- efficient compared to composing with the Monad instance. The reason is that
47+-- unfolds allow the compiler to statically know the state and optimize it
48+-- using stream fusion whereas it is not possible with the monad bind because
49+-- the state is determined dynamically.
42
50
43-- Open control flow style streams can also have two representations. StreamK
51-- Open control flow style streams can also have two representations. StreamK
44-- is a producer style representation. We can also have a consumer style
52-- is a producer style representation. We can also have a consumer style
@@ -55,22 +63,55 @@ module Streamly.Internal.Data.Unfold
55
63
56 Unfold
64 Unfold
57 , unfold
65 , unfold
66+
67+ -- * Operations on Input
68+ , close
69+ , first
70+ , second
71+ , lmap
72+ -- coapply
73+ -- comonad
74+
75+ -- * Operations on Output
58 , fold
76 , fold
77+ -- pipe
59
78
60− -- ** Unfolds
79+ -- * Unfolds
61 , singleton
80 , singleton
62 , replicateM
81 , replicateM
63 , fromList
82 , fromList
83+ , enumerateFromStepIntegral
84+ , enumerateFromToIntegral
85+ , enumerateFromIntegral
86+
87+ -- * Transformations
88+ , map
89+
90+ -- * Filtering
91+ , takeWhileM
92+ , takeWhile
93+ , take
94+ , filter
95+ , filterM
96+
97+ -- * Nesting
98+ , concat
99+ , concatMapM
100+ , outerProduct
64 )
101 )
65where
102where
66
103
104+import Data.Void (Void)
67import GHC.Types (SPEC(..))
105import GHC.Types (SPEC(..))
106+import Prelude hiding (concat, map, takeWhile, take, filter)
107+
68import Streamly.Streams.StreamD.Type (Stream(..), Step(..))
108import Streamly.Streams.StreamD.Type (Stream(..), Step(..))
69#if __GLASGOW_HASKELL__ < 800
109#if __GLASGOW_HASKELL__ < 800
70import Streamly.Streams.StreamD.Type (pattern Stream)
110import Streamly.Streams.StreamD.Type (pattern Stream)
71#endif
111#endif
72import Streamly.Internal.Data.Unfold.Types (Unfold(..))
112import Streamly.Internal.Data.Unfold.Types (Unfold(..))
73import Streamly.Internal.Data.Fold.Types (Fold(..))
113import Streamly.Internal.Data.Fold.Types (Fold(..))
114+import Streamly.Internal.Data.SVar (defState)
74
115
75-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
76-- Running unfolds
117-- Running unfolds
@@ -94,6 +135,48 @@ unfold seed (Unfold ustep inject) = Stream step Nothing
94 Skip s -> Skip (Just s)
135 Skip s -> Skip (Just s)
95 Stop -> Stop
136 Stop -> Stop
96
137
138+-------------------------------------------------------------------------------
139+-- Input operations
140+-------------------------------------------------------------------------------
141+
142+-- | Supply the seed to an unfold closing the input end of the unfold.
143+--
144+-- /Internal/
145+--
146+{-# INLINE_NORMAL close #-}
147+close :: Unfold m a b -> a -> Unfold m Void b
148+close (Unfold ustep uinject) a = Unfold ustep (const $ uinject a)
149+
150+-- XXX rename to closeFst/closeSnd
151+--
152+-- | Supply the first component of the tuple to an unfold that accepts a tuple
153+-- as a seed resulting in a fold that accepts the second component of the tuple
154+-- as a seed.
155+--
156+-- /Internal/
157+--
158+{-# INLINE_NORMAL first #-}
159+first :: Unfold m (a, b) c -> a -> Unfold m b c
160+first (Unfold ustep uinject) a = Unfold ustep (\b -> uinject (a, b))
161+
162+-- | Supply the second component of the tuple to an unfold that accepts a tuple
163+-- as a seed resulting in a fold that accepts the first component of the tuple
164+-- as a seed.
165+--
166+-- /Internal/
167+--
168+{-# INLINE_NORMAL second #-}
169+second :: Unfold m (a, b) c -> b -> Unfold m a c
170+second (Unfold ustep uinject) b = Unfold ustep (\a -> uinject (a, b))
171+
172+{-# INLINE_NORMAL lmap #-}
173+lmap :: (a -> c) -> Unfold m c b -> Unfold m a b
174+lmap f (Unfold ustep uinject) = Unfold ustep (\x -> uinject $ f x)
175+
176+-------------------------------------------------------------------------------
177+-- Output operations
178+-------------------------------------------------------------------------------
179+
97-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a
180-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a
98-- @Fold m b c@, returns a monadic action @a -> m c@ representing the
181-- @Fold m b c@, returns a monadic action @a -> m c@ representing the
99-- application of the fold on the unfolded stream.
182-- application of the fold on the unfolded stream.
@@ -116,6 +199,18 @@ fold (Unfold ustep inject) (Fold fstep initial extract) a =
116 Skip s -> go SPEC acc s
199 Skip s -> go SPEC acc s
117 Stop -> extract acc
200 Stop -> extract acc
118
201
202+{-# INLINE_NORMAL map #-}
203+map :: Monad m => (b -> c) -> Unfold m a b -> Unfold m a c
204+map f (Unfold ustep uinject) = Unfold step uinject
205+ where
206+ {-# INLINE_LATE step #-}
207+ step st = do
208+ r <- ustep st
209+ return $ case r of
210+ Yield x s -> Yield (f x) s
211+ Skip s -> Skip s
212+ Stop -> Stop
213+
119-------------------------------------------------------------------------------
214-------------------------------------------------------------------------------
120-- Unfolds
215-- Unfolds
121-------------------------------------------------------------------------------
216-------------------------------------------------------------------------------
@@ -156,3 +251,176 @@ fromList = Unfold step inject
156 {-# INLINE_LATE step #-}
251 {-# INLINE_LATE step #-}
157 step (x:xs) = return $ Yield x xs
252 step (x:xs) = return $ Yield x xs
158 step [] = return Stop
253 step [] = return Stop
254+
255+-------------------------------------------------------------------------------
256+-- Filtering
257+-------------------------------------------------------------------------------
258+
259+{-# INLINE_NORMAL take #-}
260+take :: Monad m => Int -> Unfold m a b -> Unfold m a b
261+take n (Unfold step1 inject1) = Unfold step inject
262+ where
263+ inject x = do
264+ s <- inject1 x
265+ return (s, 0)
266+ {-# INLINE_LATE step #-}
267+ step (st, i) | i < n = do
268+ r <- step1 st
269+ return $ case r of
270+ Yield x s -> Yield x (s, i + 1)
271+ Skip s -> Skip (s, i)
272+ Stop -> Stop
273+ step (_, _) = return Stop
274+
275+{-# INLINE_NORMAL takeWhileM #-}
276+takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
277+takeWhileM f (Unfold step1 inject1) = Unfold step inject1
278+ where
279+ {-# INLINE_LATE step #-}
280+ step st = do
281+ r <- step1 st
282+ case r of
283+ Yield x s -> do
284+ b <- f x
285+ return $ if b then Yield x s else Stop
286+ Skip s -> return $ Skip s
287+ Stop -> return Stop
288+
289+{-# INLINE takeWhile #-}
290+takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
291+takeWhile f = takeWhileM (return . f)
292+
293+{-# INLINE_NORMAL filterM #-}
294+filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
295+filterM f (Unfold step1 inject1) = Unfold step inject1
296+ where
297+ {-# INLINE_LATE step #-}
298+ step st = do
299+ r <- step1 st
300+ case r of
301+ Yield x s -> do
302+ b <- f x
303+ return $ if b then Yield x s else Skip s
304+ Skip s -> return $ Skip s
305+ Stop -> return Stop
306+
307+{-# INLINE filter #-}
308+filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
309+filter f = filterM (return . f)
310+
311+-------------------------------------------------------------------------------
312+-- Enumeration
313+-------------------------------------------------------------------------------
314+
315+-- | Can be used to enumerate unbounded integrals. This does not check for
316+-- overflow or underflow for bounded integrals.
317+{-# INLINE_NORMAL enumerateFromStepIntegral #-}
318+enumerateFromStepIntegral :: (Integral a, Monad m) => Unfold m (a, a) a
319+enumerateFromStepIntegral = Unfold step inject
320+ where
321+ inject (from, stride) = from `seq` stride `seq` return (from, stride)
322+ {-# INLINE_LATE step #-}
323+ step !(x, stride) = return $ Yield x $! (x + stride, stride)
324+
325+-- We are assuming that "to" is constrained by the type to be within
326+-- max/min bounds.
327+{-# INLINE enumerateFromToIntegral #-}
328+enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a
329+enumerateFromToIntegral to =
330+ takeWhile (<= to) $ second enumerateFromStepIntegral 1
331+
332+{-# INLINE enumerateFromIntegral #-}
333+enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a
334+enumerateFromIntegral = enumerateFromToIntegral maxBound
335+
336+-------------------------------------------------------------------------------
337+-- Nested
338+-------------------------------------------------------------------------------
339+
340+data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2
341+
342+{-# INLINE_NORMAL concat #-}
343+concat :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c
344+concat (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
345+ where
346+ inject x = do
347+ s <- inject1 x
348+ return $ ConcatOuter s
349+
350+ {-# INLINE_LATE step #-}
351+ step (ConcatOuter st) = do
352+ r <- step1 st
353+ case r of
354+ Yield x s -> do
355+ innerSt <- inject2 x
356+ return $ Skip (ConcatInner s innerSt)
357+ Skip s -> return $ Skip (ConcatOuter s)
358+ Stop -> return Stop
359+
360+ step (ConcatInner ost ist) = do
361+ r <- step2 ist
362+ return $ case r of
363+ Yield x s -> Yield x (ConcatInner ost s)
364+ Skip s -> Skip (ConcatInner ost s)
365+ Stop -> Skip (ConcatOuter ost)
366+
367+data OuterProductState s1 s2 sy x y =
368+ OuterProductOuter s1 y | OuterProductInner s1 sy s2 x
369+
370+{-# INLINE_NORMAL outerProduct #-}
371+outerProduct :: Monad m
372+ => Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)
373+outerProduct (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
374+ where
375+ inject (x, y) = do
376+ s1 <- inject1 x
377+ return $ OuterProductOuter s1 y
378+
379+ {-# INLINE_LATE step #-}
380+ step (OuterProductOuter st1 sy) = do
381+ r <- step1 st1
382+ case r of
383+ Yield x s -> do
384+ s2 <- inject2 sy
385+ return $ Skip (OuterProductInner s sy s2 x)
386+ Skip s -> return $ Skip (OuterProductOuter s sy)
387+ Stop -> return Stop
388+
389+ step (OuterProductInner ost sy ist x) = do
390+ r <- step2 ist
391+ return $ case r of
392+ Yield y s -> Yield (x, y) (OuterProductInner ost sy s x)
393+ Skip s -> Skip (OuterProductInner ost sy s x)
394+ Stop -> Skip (OuterProductOuter ost sy)
395+
396+-- XXX This can be used to implement a Monad instance for "Unfold m ()".
397+
398+data ConcatMapState s1 s2 = ConcatMapOuter s1 | ConcatMapInner s1 s2
399+
400+{-# INLINE_NORMAL concatMapM #-}
401+concatMapM :: Monad m
402+ => (b -> m (Unfold m () c)) -> Unfold m a b -> Unfold m a c
403+concatMapM f (Unfold step1 inject1) = Unfold step inject
404+ where
405+ inject x = do
406+ s <- inject1 x
407+ return $ ConcatMapOuter s
408+
409+ {-# INLINE_LATE step #-}
410+ step (ConcatMapOuter st) = do
411+ r <- step1 st
412+ case r of
413+ Yield x s -> do
414+ Unfold step2 inject2 <- f x
415+ innerSt <- inject2 ()
416+ return $ Skip (ConcatMapInner s (Stream (\_ ss -> step2 ss)
417+ innerSt))
418+ Skip s -> return $ Skip (ConcatMapOuter s)
419+ Stop -> return Stop
420+
421+ step (ConcatMapInner ost (Stream istep ist)) = do
422+ r <- istep defState ist
423+ return $ case r of
424+ Yield x s -> Yield x (ConcatMapInner ost (Stream istep s))
425+ Skip s -> Skip (ConcatMapInner ost (Stream istep s))
426+ Stop -> Skip (ConcatMapOuter ost)
streamly.cabal+16
@@ -571,6 +571,22 @@ benchmark nested
571 build-depends:
571 build-depends:
572 transformers >= 0.4 && < 0.6
572 transformers >= 0.4 && < 0.6
573
573
574+benchmark nestedUnfold
575+ import: bench-options
576+ type: exitcode-stdio-1.0
577+ hs-source-dirs: benchmark
578+ main-is: NestedUnfold.hs
579+ other-modules: NestedUnfoldOps
580+ build-depends:
581+ streamly
582+ , base >= 4.8 && < 5
583+ , deepseq >= 1.4.1 && < 1.5
584+ , random >= 1.0 && < 2.0
585+ , gauge >= 0.2.4 && < 0.3
586+ if impl(ghc < 8.0)
587+ build-depends:
588+ transformers >= 0.4 && < 0.6
589+
574benchmark array
590benchmark array
575 import: bench-options
591 import: bench-options
576 type: exitcode-stdio-1.0
592 type: exitcode-stdio-1.0