on master help sign in
Use an explicit state to represent nested loops
7c95ccaHarendra Kumar
benchmark/Streamly/Benchmark/Data/Parser.hs+1−1
@@ -245,7 +245,7 @@ parseManyChunksOfSum n inh =
245{-# INLINE parseManyUnfoldArrays #-}
245{-# INLINE parseManyUnfoldArrays #-}
246parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
246parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
247parseManyUnfoldArrays count arrays = do
247parseManyUnfoldArrays count arrays = do
248− let src = Source.source (Just (arrays, Nothing))
248+ let src = Source.source (Just (UnfoldR.OuterLoop arrays))
249 let parser = PR.fromFold (FL.takeLE count FL.drain)
249 let parser = PR.fromFold (FL.takeLE count FL.drain)
250 let readSrc =
250 let readSrc =
251 Source.read
251 Source.read
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+1−1
@@ -219,7 +219,7 @@ parseManyGroupsRolling b =
219{-# INLINE parseManyUnfoldArrays #-}
219{-# INLINE parseManyUnfoldArrays #-}
220parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
220parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
221parseManyUnfoldArrays count arrays = do
221parseManyUnfoldArrays count arrays = do
222− let src = Source.source (Just (arrays, Nothing))
222+ let src = Source.source (Just (UnfoldR.OuterLoop arrays))
223 let parser = PR.fromFold (FL.takeLE count FL.drain)
223 let parser = PR.fromFold (FL.takeLE count FL.drain)
224 let readSrc =
224 let readSrc =
225 Source.read
225 Source.read
src/Streamly/Internal/Data/Unfold/Resume.hs+1
@@ -39,6 +39,7 @@ module Streamly.Internal.Data.Unfold.Resume
39 , fromList
39 , fromList
40
40
41 -- * Combinators
41 -- * Combinators
42+ , NestedLoop (..)
42 , concat
43 , concat
43 , parse
44 , parse
44 , parseMany
45 , parseMany
src/Streamly/Internal/Data/Unfold/Resume/Type.hs+35−22
@@ -25,6 +25,7 @@ module Streamly.Internal.Data.Unfold.Resume.Type
25 , lmap
25 , lmap
26
26
27 -- * Nesting
27 -- * Nesting
28+ , NestedLoop (..)
28 , concat
29 , concat
29 )
30 )
30where
31where
@@ -39,6 +40,17 @@ import Prelude hiding (concat)
39-- Type
40-- Type
40------------------------------------------------------------------------------
41------------------------------------------------------------------------------
41
42
43+{-
44+-- Representing open loops.
45+-- Stepper/Iterator/Generator/Producer
46+-- | A function that can be called repeatedly to generate a sequence of values.
47+data Producer m a b = Producer (a -> m (Step a b))
48+
49+-- A similar concept for folds would be an accumulator/reducer/Consumer
50+-- | A function that can be called repeatedly to consume a sequence of values.
51+data Consumer m a b = Consumer (s -> a -> m (Step b))
52+-}
53+
42-- | An @Unfold m a b@ is a generator of a stream of values of type @b@ from a
54-- | An @Unfold m a b@ is a generator of a stream of values of type @b@ from a
43-- seed of type 'a' in 'Monad' @m@.
55-- seed of type 'a' in 'Monad' @m@.
44--
56--
@@ -81,9 +93,10 @@ unfoldrM next = Unfold step return return
81-- /Internal/
93-- /Internal/
82{-# INLINE_LATE fromList #-}
94{-# INLINE_LATE fromList #-}
83fromList :: Monad m => Unfold m [a] a
95fromList :: Monad m => Unfold m [a] a
84−fromList = Unfold step inject return
96+fromList = Unfold step return return
97+
85− where
98+ where
86− inject = return
99+
87 {-# INLINE_LATE step #-}
100 {-# INLINE_LATE step #-}
88 step (x:xs) = return $ Yield x xs
101 step (x:xs) = return $ Yield x xs
89 step [] = return Stop
102 step [] = return Stop
@@ -105,50 +118,50 @@ lmap f g (Unfold ustep uinject uextract) =
105-- Nesting
118-- Nesting
106------------------------------------------------------------------------------
119------------------------------------------------------------------------------
107
120
121+-- | State representing a nested loop.
108−{-# ANN type ConcatState Fuse #-}
122+{-# ANN type NestedLoop Fuse #-}
109−data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2
123+data NestedLoop s1 s2 = OuterLoop s1 | InnerLoop s1 s2
110
124
111−-- XXX Use Either a (a,b) for extracted state.
112−--
113-- | Apply the second unfold to each output element of the first unfold and
125-- | Apply the second unfold to each output element of the first unfold and
114-- flatten the output in a single stream.
126-- flatten the output in a single stream.
115--
127--
116-- /Internal/
128-- /Internal/
117--
129--
118{-# INLINE_NORMAL concat #-}
130{-# INLINE_NORMAL concat #-}
131+concat :: Monad m =>
119−concat :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m (a, Maybe b) c
132+ Unfold m a b -> Unfold m b c -> Unfold m (NestedLoop a b) c
120concat (Unfold step1 inject1 extract1) (Unfold step2 inject2 extract2) =
133concat (Unfold step1 inject1 extract1) (Unfold step2 inject2 extract2) =
121 Unfold step inject extract
134 Unfold step inject extract
122
135
123 where
136 where
124
137
125− inject (x, Nothing) = do
138+ inject (OuterLoop x) = do
126 s <- inject1 x
139 s <- inject1 x
127− return $ ConcatOuter s
140+ return $ OuterLoop s
128− inject (x, Just y) = do
141+ inject (InnerLoop x y) = do
129 s1 <- inject1 x
142 s1 <- inject1 x
130 s2 <- inject2 y
143 s2 <- inject2 y
131− return $ ConcatInner s1 s2
144+ return $ InnerLoop s1 s2
132
145
133 {-# INLINE_LATE step #-}
146 {-# INLINE_LATE step #-}
134− step (ConcatOuter st) = do
147+ step (OuterLoop st) = do
135 r <- step1 st
148 r <- step1 st
136 case r of
149 case r of
137 Yield x s -> do
150 Yield x s -> do
138 innerSt <- inject2 x
151 innerSt <- inject2 x
139− return $ Skip (ConcatInner s innerSt)
152+ return $ Skip (InnerLoop s innerSt)
140− Skip s -> return $ Skip (ConcatOuter s)
153+ Skip s -> return $ Skip (OuterLoop s)
141 Stop -> return Stop
154 Stop -> return Stop
142
155
143− step (ConcatInner ost ist) = do
156+ step (InnerLoop ost ist) = do
144 r <- step2 ist
157 r <- step2 ist
145 return $ case r of
158 return $ case r of
146− Yield x s -> Yield x (ConcatInner ost s)
159+ Yield x s -> Yield x (InnerLoop ost s)
147− Skip s -> Skip (ConcatInner ost s)
160+ Skip s -> Skip (InnerLoop ost s)
148− Stop -> Skip (ConcatOuter ost)
161+ Stop -> Skip (OuterLoop ost)
149
162
150− extract (ConcatOuter s1) = (,Nothing) <$> extract1 s1
163+ extract (OuterLoop s1) = OuterLoop <$> extract1 s1
151− extract (ConcatInner s1 s2) = do
164+ extract (InnerLoop s1 s2) = do
152 r1 <- extract1 s1
165 r1 <- extract1 s1
153 r2 <- extract2 s2
166 r2 <- extract2 s2
154− return (r1, Just r2)
167+ return (InnerLoop r1 r2)
test/Streamly/Test/Data/Parser/ParserD.hs+1−1
@@ -621,7 +621,7 @@ parseUnfold = do
621 <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
621 <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
622 monadicIO $ do
622 monadicIO $ do
623 arrays <- S.toList $ S.arraysOf clen (S.fromList ls)
623 arrays <- S.toList $ S.arraysOf clen (S.fromList ls)
624− let src = Source.source (Just (arrays, Nothing))
624+ let src = Source.source (Just (UnfoldR.OuterLoop arrays))
625 let parser = P.fromFold (FL.takeLE tlen FL.toList)
625 let parser = P.fromFold (FL.takeLE tlen FL.toList)
626 let readSrc =
626 let readSrc =
627 Source.read
627 Source.read