Skip to content

Commit 7f57f36

Browse files
harendra-kumarharendra-kumar
committed
Move parseMany to ParserDrivers.hs module
1 parent 103bce5 commit 7f57f36

File tree

6 files changed

+334
-297
lines changed

6 files changed

+334
-297
lines changed

‎core/src/Streamly/Internal/Data/ParserDrivers.h‎

Lines changed: 256 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
#define PARSE_BREAK parseBreak
33
#define PARSE_BREAK_CHUNKS parseBreakChunks
44
#define PARSE_BREAK_CHUNKS_GENERIC parseBreakChunksGeneric
5+
#define PARSE_MANY parseMany
56
#define OPTIONAL(x)
67
#define DEFAULT(x) 0
78
#else
@@ -11,12 +12,267 @@
1112
#define PARSE_BREAK_CHUNKS parseBreakChunksPos
1213
#undef PARSE_BREAK_CHUNKS_GENERIC
1314
#define PARSE_BREAK_CHUNKS_GENERIC parseBreakChunksGenericPos
15+
16+
#define ParseChunksState ParseChunksStatePos
17+
#define ParseChunksInit ParseChunksInitPos
18+
#define ParseChunksInitBuf ParseChunksInitBufPos
19+
#define ParseChunksInitLeftOver ParseChunksInitLeftOverPos
20+
#define ParseChunksStream ParseChunksStreamPos
21+
#define ParseChunksStop ParseChunksStopPos
22+
#define ParseChunksBuf ParseChunksBufPos
23+
#define ParseChunksExtract ParseChunksExtractPos
24+
#define ParseChunksYield ParseChunksYieldPos
25+
26+
#undef PARSE_MANY
27+
#define PARSE_MANY parseManyPos
1428
#undef OPTIONAL
1529
#define OPTIONAL(x) (x)
1630
#undef DEFAULT
1731
#define DEFAULT(x) (x)
1832
#endif
1933

34+
{-# ANN type ParseChunksState Fuse #-}
35+
data ParseChunksState x inpBuf st pst =
36+
ParseChunksInit OPTIONAL(Int) inpBuf st
37+
| ParseChunksInitBuf OPTIONAL(Int) inpBuf
38+
| ParseChunksInitLeftOver OPTIONAL(Int) inpBuf
39+
| ParseChunksStream OPTIONAL(Int) st inpBuf !pst
40+
| ParseChunksStop OPTIONAL(Int) inpBuf !pst
41+
| ParseChunksBuf OPTIONAL(Int) inpBuf st inpBuf !pst
42+
| ParseChunksExtract OPTIONAL(Int) inpBuf inpBuf !pst
43+
| ParseChunksYield x (ParseChunksState x inpBuf st pst)
44+
45+
-- XXX return the remaining stream as part of the error.
46+
{-# INLINE_NORMAL PARSE_MANY #-}
47+
PARSE_MANY
48+
:: Monad m
49+
=> PRD.Parser a m b
50+
-> Stream m a
51+
-> Stream m (Either ParseError b)
52+
PARSE_MANY (PRD.Parser pstep initial extract) (Stream step state) =
53+
Stream stepOuter (ParseChunksInit OPTIONAL(0) [] state)
54+
55+
where
56+
57+
{-# INLINE splitAt #-}
58+
splitAt = Stream.splitAt "Data.StreamK.parseMany"
59+
60+
{-# INLINE_LATE stepOuter #-}
61+
-- Buffer is empty, get the first element from the stream, initialize the
62+
-- fold and then go to stream processing loop.
63+
stepOuter gst (ParseChunksInit OPTIONAL(i) [] st) = do
64+
r <- step (adaptState gst) st
65+
case r of
66+
Yield x s -> do
67+
res <- initial
68+
case res of
69+
PRD.IPartial ps ->
70+
return $ Skip $ ParseChunksBuf OPTIONAL(i) [x] s [] ps
71+
PRD.IDone pb ->
72+
let next = ParseChunksInit OPTIONAL(i) [x] s
73+
in return $ Skip $ ParseChunksYield (Right pb) next
74+
PRD.IError err ->
75+
return
76+
$ Skip
77+
$ ParseChunksYield
78+
(Left (ParseError DEFAULT(i) err))
79+
(ParseChunksInitLeftOver OPTIONAL(i) [])
80+
Skip s -> return $ Skip $ ParseChunksInit OPTIONAL(i) [] s
81+
Stop -> return Stop
82+
83+
-- Buffer is not empty, go to buffered processing loop
84+
stepOuter _ (ParseChunksInit OPTIONAL(i) src st) = do
85+
res <- initial
86+
case res of
87+
PRD.IPartial ps ->
88+
return $ Skip $ ParseChunksBuf OPTIONAL(i) src st [] ps
89+
PRD.IDone pb ->
90+
let next = ParseChunksInit OPTIONAL(i) src st
91+
in return $ Skip $ ParseChunksYield (Right pb) next
92+
PRD.IError err ->
93+
return
94+
$ Skip
95+
$ ParseChunksYield
96+
(Left (ParseError DEFAULT(i) err))
97+
(ParseChunksInitLeftOver OPTIONAL(i) [])
98+
99+
-- This is simplified ParseChunksInit
100+
stepOuter _ (ParseChunksInitBuf OPTIONAL(i) src) = do
101+
res <- initial
102+
case res of
103+
PRD.IPartial ps ->
104+
return $ Skip $ ParseChunksExtract OPTIONAL(i) src [] ps
105+
PRD.IDone pb ->
106+
let next = ParseChunksInitBuf OPTIONAL(i) src
107+
in return $ Skip $ ParseChunksYield (Right pb) next
108+
PRD.IError err ->
109+
return
110+
$ Skip
111+
$ ParseChunksYield
112+
(Left (ParseError DEFAULT(i) err))
113+
(ParseChunksInitLeftOver OPTIONAL(i) [])
114+
115+
-- XXX we just discard any leftover input at the end
116+
stepOuter _ (ParseChunksInitLeftOver OPTIONAL(_) _) = return Stop
117+
118+
-- Buffer is empty, process elements from the stream
119+
stepOuter gst (ParseChunksStream OPTIONAL(i) st buf pst) = do
120+
r <- step (adaptState gst) st
121+
case r of
122+
Yield x s -> do
123+
pRes <- pstep pst x
124+
case pRes of
125+
PR.SPartial 1 pst1 ->
126+
return $ Skip $ ParseChunksStream OPTIONAL(i + 1) s [] pst1
127+
PR.SPartial m pst1 -> do
128+
let n = 1 - m
129+
assert (n <= length (x:buf)) (return ())
130+
let src0 = Prelude.take n (x:buf)
131+
src = Prelude.reverse src0
132+
return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s [] pst1
133+
PR.SContinue 1 pst1 ->
134+
return $ Skip $ ParseChunksStream OPTIONAL(i + 1) s (x:buf) pst1
135+
PR.SContinue m pst1 -> do
136+
let n = 1 - m
137+
assert (n <= length (x:buf)) (return ())
138+
let (src0, buf1) = splitAt n (x:buf)
139+
src = Prelude.reverse src0
140+
return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s buf1 pst1
141+
PR.SDone 1 b -> do
142+
return $ Skip $
143+
ParseChunksYield
144+
(Right b) (ParseChunksInit OPTIONAL(i + 1) [] s)
145+
PR.SDone m b -> do
146+
let n = 1 - m
147+
assert (n <= length (x:buf)) (return ())
148+
let src = Prelude.reverse (Prelude.take n (x:buf))
149+
return $ Skip $
150+
ParseChunksYield
151+
(Right b) (ParseChunksInit OPTIONAL(i + m) src s)
152+
PR.Error err ->
153+
return
154+
$ Skip
155+
$ ParseChunksYield
156+
(Left (ParseError (DEFAULT(i) + 1) err))
157+
(ParseChunksInitLeftOver OPTIONAL(i + 1) [])
158+
Skip s -> return $ Skip $ ParseChunksStream OPTIONAL(i) s buf pst
159+
Stop -> return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst
160+
161+
-- go back to stream processing mode
162+
stepOuter _ (ParseChunksBuf OPTIONAL(i) [] s buf pst) =
163+
return $ Skip $ ParseChunksStream OPTIONAL(i) s buf pst
164+
165+
-- buffered processing loop
166+
stepOuter _ (ParseChunksBuf OPTIONAL(i) (x:xs) s buf pst) = do
167+
pRes <- pstep pst x
168+
case pRes of
169+
PR.SPartial 1 pst1 ->
170+
return $ Skip $ ParseChunksBuf OPTIONAL(i + 1) xs s [] pst1
171+
PR.SPartial m pst1 -> do
172+
let n = 1 - m
173+
assert (n <= length (x:buf)) (return ())
174+
let src0 = Prelude.take n (x:buf)
175+
src = Prelude.reverse src0 ++ xs
176+
return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s [] pst1
177+
PR.SContinue 1 pst1 ->
178+
return $ Skip $ ParseChunksBuf OPTIONAL(i + 1) xs s (x:buf) pst1
179+
PR.SContinue m pst1 -> do
180+
let n = 1 - m
181+
assert (n <= length (x:buf)) (return ())
182+
let (src0, buf1) = splitAt n (x:buf)
183+
src = Prelude.reverse src0 ++ xs
184+
return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s buf1 pst1
185+
PR.SDone 1 b ->
186+
return
187+
$ Skip
188+
$ ParseChunksYield (Right b) (ParseChunksInit OPTIONAL(i + 1) xs s)
189+
PR.SDone m b -> do
190+
let n = 1 - m
191+
assert (n <= length (x:buf)) (return ())
192+
let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
193+
return $ Skip
194+
$ ParseChunksYield
195+
(Right b) (ParseChunksInit OPTIONAL(i + m) src s)
196+
PR.Error err ->
197+
return
198+
$ Skip
199+
$ ParseChunksYield
200+
(Left (ParseError DEFAULT(i + 1) err))
201+
(ParseChunksInitLeftOver OPTIONAL(i + 1) [])
202+
203+
-- This is simplified ParseChunksBuf
204+
stepOuter _ (ParseChunksExtract OPTIONAL(i) [] buf pst) =
205+
return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst
206+
207+
stepOuter _ (ParseChunksExtract OPTIONAL(i) (x:xs) buf pst) = do
208+
pRes <- pstep pst x
209+
case pRes of
210+
PR.SPartial 1 pst1 ->
211+
return $ Skip $ ParseChunksExtract OPTIONAL(i + 1) xs [] pst1
212+
PR.SPartial m pst1 -> do
213+
let n = 1 - m
214+
assert (n <= length (x:buf)) (return ())
215+
let src0 = Prelude.take n (x:buf)
216+
src = Prelude.reverse src0 ++ xs
217+
return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src [] pst1
218+
PR.SContinue 1 pst1 ->
219+
return $ Skip $ ParseChunksExtract OPTIONAL(i + 1) xs (x:buf) pst1
220+
PR.SContinue m pst1 -> do
221+
let n = 1 - m
222+
assert (n <= length (x:buf)) (return ())
223+
let (src0, buf1) = splitAt n (x:buf)
224+
src = Prelude.reverse src0 ++ xs
225+
return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src buf1 pst1
226+
PR.SDone 1 b ->
227+
return
228+
$ Skip
229+
$ ParseChunksYield (Right b) (ParseChunksInitBuf OPTIONAL(i + 1) xs)
230+
PR.SDone m b -> do
231+
let n = 1 - m
232+
assert (n <= length (x:buf)) (return ())
233+
let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
234+
return
235+
$ Skip
236+
$ ParseChunksYield
237+
(Right b) (ParseChunksInitBuf OPTIONAL(i + m) src)
238+
PR.Error err ->
239+
return
240+
$ Skip
241+
$ ParseChunksYield
242+
(Left (ParseError (DEFAULT(i) + 1) err))
243+
(ParseChunksInitLeftOver OPTIONAL(i + 1) [])
244+
245+
-- This is simplified ParseChunksExtract
246+
stepOuter _ (ParseChunksStop OPTIONAL(i) buf pst) = do
247+
pRes <- extract pst
248+
case pRes of
249+
PR.SPartial _ _ -> error "Bug: parseMany: Partial in extract"
250+
PR.SContinue 0 pst1 ->
251+
return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst1
252+
PR.SContinue m pst1 -> do
253+
let n = (- m)
254+
assert (n <= length buf) (return ())
255+
let (src0, buf1) = splitAt n buf
256+
src = Prelude.reverse src0
257+
return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src buf1 pst1
258+
PR.SDone 0 b -> do
259+
return $ Skip $
260+
ParseChunksYield (Right b) (ParseChunksInitLeftOver OPTIONAL(i) [])
261+
PR.SDone m b -> do
262+
let n = (- m)
263+
assert (n <= length buf) (return ())
264+
let src = Prelude.reverse (Prelude.take n buf)
265+
return $ Skip $
266+
ParseChunksYield (Right b) (ParseChunksInitBuf OPTIONAL(i + m) src)
267+
PR.Error err ->
268+
return
269+
$ Skip
270+
$ ParseChunksYield
271+
(Left (ParseError DEFAULT(i) err))
272+
(ParseChunksInitLeftOver OPTIONAL(i) [])
273+
274+
stepOuter _ (ParseChunksYield a next) = return $ Yield a next
275+
20276
{-# INLINE PARSE_BREAK #-}
21277
PARSE_BREAK :: Monad m =>
22278
PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)

‎core/src/Streamly/Internal/Data/ParserDrivers.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,8 @@ module Streamly.Internal.Data.ParserDrivers
1616
, parseBreakChunksPos
1717
, parseBreakChunksGeneric
1818
, parseBreakChunksGenericPos
19+
, parseMany
20+
, parseManyPos
1921
)
2022
where
2123

@@ -24,23 +26,24 @@ module Streamly.Internal.Data.ParserDrivers
2426
#include "ArrayMacros.h"
2527

2628
import Data.Proxy (Proxy(..))
29+
import Fusion.Plugin.Types (Fuse(..))
2730
import GHC.Exts (SpecConstrAnnotation(..))
2831
import GHC.Types (SPEC(..))
2932
import Streamly.Internal.Data.Array.Type (Array(..))
3033
import Streamly.Internal.Data.Parser (ParseError(..))
3134
import Streamly.Internal.Data.ParserK.Type (ParserK)
3235
import Streamly.Internal.Data.StreamK.Type (StreamK)
33-
import Streamly.Internal.Data.SVar.Type (defState)
36+
import Streamly.Internal.Data.SVar.Type (adaptState, defState)
3437
import Streamly.Internal.Data.Unbox (Unbox(..))
3538

3639
import qualified Streamly.Internal.Data.Array.Type as Array
3740
import qualified Streamly.Internal.Data.Array.Generic.Type as GArray
3841
import qualified Streamly.Internal.Data.Parser as PR
3942
import qualified Streamly.Internal.Data.Parser as PRD
4043
import qualified Streamly.Internal.Data.ParserK.Type as ParserK
44+
import qualified Streamly.Internal.Data.Stream.Type as Nesting
4145
import qualified Streamly.Internal.Data.Stream.Type as Stream
4246
import qualified Streamly.Internal.Data.Stream.Generate as StreamD
43-
import qualified Streamly.Internal.Data.Stream.Nesting as Nesting
4447
import qualified Streamly.Internal.Data.StreamK.Type as StreamK
4548

4649
import Streamly.Internal.Data.Stream.Type hiding (splitAt)

‎core/src/Streamly/Internal/Data/Stream/Container.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,6 @@ import qualified Streamly.Data.Fold as Fold
4141
import qualified Streamly.Internal.Data.Array.Generic as Array
4242
import qualified Streamly.Internal.Data.MutArray.Type as MA
4343
import qualified Streamly.Internal.Data.Stream.Type as Stream
44-
import qualified Streamly.Internal.Data.Stream.Nesting as Stream
4544
import qualified Streamly.Internal.Data.Stream.Generate as Stream
4645
import qualified Streamly.Internal.Data.Stream.Transform as Stream
4746
import qualified Streamly.Internal.Data.Stream.Transformer as Stream

0 commit comments

Comments
 (0)