@@ -39,6 +39,14 @@
3939-- these are stream consumers that reduce the stream to a single value, these
4040-- consumers can be composed such that a stream can be split over multiple
4141-- 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.
4250
4351-- Open control flow style streams can also have two representations. StreamK
4452-- is a producer style representation. We can also have a consumer style
@@ -55,22 +63,55 @@ module Streamly.Internal.Data.Unfold
5563
5664 Unfold
5765 , unfold
66+
67+ -- * Operations on Input
68+ , close
69+ , first
70+ , second
71+ , lmap
72+ -- coapply
73+ -- comonad
74+
75+ -- * Operations on Output
5876 , fold
77+ -- pipe
5978
60− -- ** Unfolds
79+ -- * Unfolds
6180 , singleton
6281 , replicateM
6382 , 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
64101 )
65102where
66103
104+import Data.Void (Void)
67105import GHC.Types (SPEC(..))
106+import Prelude hiding (concat, map, takeWhile, take, filter)
107+
68108import Streamly.Streams.StreamD.Type (Stream(..), Step(..))
69109#if __GLASGOW_HASKELL__ < 800
70110import Streamly.Streams.StreamD.Type (pattern Stream)
71111#endif
72112import Streamly.Internal.Data.Unfold.Types (Unfold(..))
73113import Streamly.Internal.Data.Fold.Types (Fold(..))
114+import Streamly.Internal.Data.SVar (defState)
74115
75116-------------------------------------------------------------------------------
76117-- Running unfolds
@@ -94,6 +135,48 @@ unfold seed (Unfold ustep inject) = Stream step Nothing
94135 Skip s -> Skip (Just s)
95136 Stop -> Stop
96137
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+
97180-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a
98181-- @Fold m b c@, returns a monadic action @a -> m c@ representing the
99182-- application of the fold on the unfolded stream.
@@ -116,6 +199,18 @@ fold (Unfold ustep inject) (Fold fstep initial extract) a =
116199 Skip s -> go SPEC acc s
117200 Stop -> extract acc
118201
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+
119214-------------------------------------------------------------------------------
120215-- Unfolds
121216-------------------------------------------------------------------------------
@@ -156,3 +251,176 @@ fromList = Unfold step inject
156251 {-# INLINE_LATE step #-}
157252 step (x:xs) = return $ Yield x xs
158253 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)