git.iko.soy/streamly
on master help sign in
Improve performance of the chunked parser
4f86266Harendra Kumar
core/src/Streamly/Internal/Data/Parser/Chunked.hs+160−165
compare with master
unifiedsplit
@@ -10,7 +10,7 @@
10
10
11module Streamly.Internal.Data.Parser.Chunked
11module Streamly.Internal.Data.Parser.Chunked
12 (
12 (
13− ParserChunked (..)
13+ ParserChunked (..) -- XXX rename to ChunkParser
14 , fromParserD
14 , fromParserD
15 , parseBreak
15 , parseBreak
16 , K.fromPure
16 , K.fromPure
@@ -76,11 +76,10 @@ backTrack = go
76
76
77-- | A continuation to extract the result when a CPS parser is done.
77-- | A continuation to extract the result when a CPS parser is done.
78{-# INLINE parserDone #-}
78{-# INLINE parserDone #-}
79−parserDone :: Monad m => (Int, Int) -> K.Parse b -> m (K.Step m a b)
79+parserDone :: Monad m =>
80+ K.ParseResult b -> Int -> Maybe (Array a) -> m (K.Step a m b)
80−parserDone (0,_) (K.Success n b) = return $ K.Done n b
81+parserDone (K.Success n b) _ _ = return $ K.Done n b
81−parserDone st (K.Success _ _) =
82− error $ "Bug: fromParserK: inside alternative: " ++ show st
83−parserDone _ (K.Failure e) = return $ K.Error e
82+parserDone (K.Failure n e) _ _ = return $ K.Error n e
84
83
85-- | Run a 'Parser' over a stream and return rest of the Stream.
84-- | Run a 'Parser' over a stream and return rest of the Stream.
86{-# INLINE_NORMAL parseBreak #-}
85{-# INLINE_NORMAL parseBreak #-}
@@ -90,47 +89,11 @@ parseBreak
90 -> Stream m (Array a)
89 -> Stream m (Array a)
91 -> m (b, Stream m (Array a))
90 -> m (b, Stream m (Array a))
92parseBreak parser input = do
91parseBreak parser input = do
93− pRes <- K.runParser parser 0 (0,0) parserDone
92+ let parserk = \arr -> K.runParser parser 0 0 arr parserDone
94− case pRes of
95− K.Done n b -> assert (n == 0) (return (b, input))
96− K.Error e -> throwM (D.ParseError e)
97− K.Partial n parserk ->
98− assert (n == 0) (go [] parserk (Stream.toStreamK input))
93+ in go [] parserk (Stream.toStreamK input)
99− K.Continue n parserk ->
100− assert (n == 0) (go [] parserk (Stream.toStreamK input))
101
94
102 where
95 where
103
96
104− -- This is a simplified yieldk
105− extractYieldK backBuf parserk arr stream = do
106− pRes <- parserk (Just arr)
107− case pRes of
108− K.Partial 0 cont1 ->
109− goExtract [] cont1 stream
110− K.Partial n cont1 -> do
111− assertM(n <= sum (map Array.length (arr:backBuf)))
112− goExtract [] cont1 (fst $ backTrack n (arr:backBuf) stream)
113− K.Continue 0 cont1 ->
114− go (arr:backBuf) cont1 stream
115− K.Continue n cont1 -> do
116− assertM(n <= sum (map Array.length (arr:backBuf)))
117− let (s1, backBuf1) = backTrack n (arr:backBuf) stream
118− in go backBuf1 cont1 s1
119− K.Done 0 b ->
120− return (b, Stream.fromStreamK stream)
121− K.Done n b -> do
122− assertM(n <= sum (map Array.length (arr:backBuf)))
123− let (s1, _) = backTrack n (arr:backBuf) stream
124− in return (b, Stream.fromStreamK s1)
125− K.Error err -> throwM $ D.ParseError err
126−
127− goExtract backBuf parserk stream = do
128− let stop = goStop backBuf parserk
129− single a = extractYieldK backBuf parserk a StreamK.nil
130− in StreamK.foldStream
131− defState (extractYieldK backBuf parserk) single stop stream
132−
133− -- This is a simplified goExtract
134 {-# INLINE goStop #-}
97 {-# INLINE goStop #-}
135 goStop backBuf parserk = do
98 goStop backBuf parserk = do
136 pRes <- parserk Nothing
99 pRes <- parserk Nothing
@@ -138,49 +101,71 @@ parseBreak parser input = do
138 -- If we stop in an alternative, it will try calling the next
101 -- If we stop in an alternative, it will try calling the next
139 -- parser, the next parser may call initial returning Partial and
102 -- parser, the next parser may call initial returning Partial and
140 -- then immediately we have to call extract on it.
103 -- then immediately we have to call extract on it.
141− K.Partial 0 cont1 -> do
104+ K.Partial 0 cont1 ->
142− goExtract [] cont1 StreamK.nil
105+ go [] cont1 StreamK.nil
143 K.Partial n cont1 -> do
106 K.Partial n cont1 -> do
144− -- error $ "Bug: parseBreak: Partial in extract, n = " ++ show n
107+ let n1 = negate n
145− assertM(n <= sum (map Array.length backBuf))
108+ assertM(n1 >= 0 && n1 <= sum (map Array.length backBuf))
146− let (s1, backBuf1) = backTrack n backBuf StreamK.nil
109+ let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil
147− in goExtract backBuf1 cont1 s1
110+ in go backBuf1 cont1 s1
148− K.Continue 0 cont1 -> do
111+ K.Continue 0 cont1 ->
149− -- error "parseBreak: extract, Continue 0 creates infinite loop"
150 go backBuf cont1 StreamK.nil
112 go backBuf cont1 StreamK.nil
151 K.Continue n cont1 -> do
113 K.Continue n cont1 -> do
114+ let n1 = negate n
152− assertM(n <= sum (map Array.length backBuf))
115+ assertM(n1 >= 0 && n1 <= sum (map Array.length backBuf))
153− let (s1, backBuf1) = backTrack n backBuf StreamK.nil
116+ let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil
154− in goExtract backBuf1 cont1 s1
117+ in go backBuf1 cont1 s1
118+ K.Done 0 b ->
155− K.Done 0 b -> return (b, Stream.nil)
119+ return (b, Stream.nil)
156 K.Done n b -> do
120 K.Done n b -> do
121+ let n1 = negate n
157− assertM(n <= sum (map Array.length backBuf))
122+ assertM(n1 >= 0 && n1 <= sum (map Array.length backBuf))
158− let (s1, _) = backTrack n backBuf StreamK.nil
123+ let (s1, _) = backTrack n1 backBuf StreamK.nil
159 in return (b, Stream.fromStreamK s1)
124 in return (b, Stream.fromStreamK s1)
160− K.Error err -> throwM $ D.ParseError err
125+ K.Error _ err -> throwM $ D.ParseError err
161
126
162− -- SPECIALIZE this on backBuf?
127+ seekErr n len =
128+ error $ "parseBreak: Partial: forward seek not implemented n = "
129+ ++ show n ++ " len = " ++ show len
130+
163− yieldk backBuf !parserk arr stream = do
131+ yieldk backBuf parserk arr stream = do
164 pRes <- parserk (Just arr)
132 pRes <- parserk (Just arr)
133+ let len = Array.length arr
165 case pRes of
134 case pRes of
166− K.Partial 0 cont1 ->
135+ K.Partial n cont1 ->
136+ case compare n len of
167− go [] cont1 stream
137+ EQ -> go [] cont1 stream
168− K.Partial n cont1 -> do
138+ LT -> do
139+ if n >= 0
140+ then yieldk [] cont1 arr stream
141+ else do
142+ let n1 = negate n
169− assertM(n <= sum (map Array.length (arr:backBuf)))
143+ bufLen = sum (map Array.length backBuf)
170− go [] cont1 (fst $ backTrack n (arr:backBuf) stream)
144+ s = StreamK.cons arr stream
145+ assertM(n1 >= 0 && n1 <= bufLen)
146+ let (s1, _) = backTrack n1 backBuf s
147+ go [] cont1 s1
148+ GT -> seekErr n len
171− K.Continue 0 cont1 ->
149+ K.Continue n cont1 ->
150+ case compare n len of
172− go (arr:backBuf) cont1 stream
151+ EQ -> go (arr:backBuf) cont1 stream
173− K.Continue n cont1 -> do
152+ LT -> do
153+ if n >= 0
154+ then yieldk backBuf cont1 arr stream
155+ else do
156+ let n1 = negate n
174− assertM(n <= sum (map Array.length (arr:backBuf)))
157+ bufLen = sum (map Array.length backBuf)
158+ s = StreamK.cons arr stream
159+ assertM(n1 >= 0 && n1 <= bufLen)
175− let (s1, backBuf1) = backTrack n (arr:backBuf) stream
160+ let (s1, backBuf1) = backTrack n1 backBuf s
176− in go backBuf1 cont1 s1
161+ go backBuf1 cont1 s1
177− K.Done 0 b ->
162+ GT -> seekErr n len
178− return (b, Stream.fromStreamK stream)
179 K.Done n b -> do
163 K.Done n b -> do
164+ let n1 = len - n
180− assertM(n <= sum (map Array.length (arr:backBuf)))
165+ assertM(n1 <= sum (map Array.length (arr:backBuf)))
181− let (s1, _) = backTrack n (arr:backBuf) stream
166+ let (s1, _) = backTrack n1 (arr:backBuf) stream
182 in return (b, Stream.fromStreamK s1)
167 in return (b, Stream.fromStreamK s1)
183− K.Error err -> throwM $ D.ParseError err
168+ K.Error _ err -> throwM $ D.ParseError err
184
169
185 go backBuf parserk stream = do
170 go backBuf parserk stream = do
186 let stop = goStop backBuf parserk
171 let stop = goStop backBuf parserk
@@ -188,6 +173,12 @@ parseBreak parser input = do
188 in StreamK.foldStream
173 in StreamK.foldStream
189 defState (yieldk backBuf parserk) single stop stream
174 defState (yieldk backBuf parserk) single stop stream
190
175
176+data ChunkResult s b =
177+ ChunkDone !Int !b
178+ | ChunkPartial !Int !s
179+ | ChunkContinue !Int !s
180+ | ChunkError !Int String
181+
191-- This is very similar to fromParserD in the Array/Unboxed/Fold module.
182-- This is very similar to fromParserD in the Array/Unboxed/Fold module.
192{-# INLINE parseChunk #-}
183{-# INLINE parseChunk #-}
193parseChunk
184parseChunk
@@ -195,122 +186,126 @@ parseChunk
195 => (s -> a -> m (Step s b))
186 => (s -> a -> m (Step s b))
196 -> s
187 -> s
197 -> Array a
188 -> Array a
198− -> m (Step s b)
189+ -> Int
190+ -> m (ChunkResult s b)
199−parseChunk pstep state (Array contents start end) = do
191+parseChunk pstep state (Array contents start end) offset = do
192+ if offset >= 0
200− go SPEC start state
193+ then go SPEC (start + offset * SIZE_OF(a)) state
194+ else return $ ChunkContinue offset state
201
195
202 where
196 where
203
197
204− {-# INLINE partial #-}
198+ {-# INLINE onBack #-}
205− partial arrRem cur next elemSize st n fs1 = do
199+ onBack offset1 elemSize constr pst = do
206− let next1 = next - (n * elemSize)
200+ let pos = offset1 - start
207− if next1 >= start && cur < end
201+ in if pos >= 0
208− then go SPEC next1 fs1
202+ then go SPEC offset1 pst
209− else return $ st (arrRem + n) fs1
203+ else return $ constr (pos `div` elemSize) pst
210
204
205+ -- Note: div may be expensive but the alternative is to maintain an element
206+ -- offset in addition to a byte offset or just the element offset and use
207+ -- multiplication to get the byte offset every time, both these options
208+ -- turned out to be more expensive than using div.
211− go !_ !cur !pst | cur >= end = return $ Continue 0 pst
209+ go !_ !cur !pst | cur >= end =
210+ return $ ChunkContinue ((end - start) `div` SIZE_OF(a)) pst
212 go !_ !cur !pst = do
211 go !_ !cur !pst = do
213 x <- liftIO $ peekWith contents cur
212 x <- liftIO $ peekWith contents cur
214 pRes <- pstep pst x
213 pRes <- pstep pst x
215 let elemSize = SIZE_OF(a)
214 let elemSize = SIZE_OF(a)
216 next = INDEX_NEXT(cur,a)
215 next = INDEX_NEXT(cur,a)
216+ back n = next - n * elemSize
217+ curOff = (cur - start) `div` elemSize
217− arrRem = (end - next) `div` elemSize
218+ nextOff = (next - start) `div` elemSize
218 case pRes of
219 case pRes of
219− Done n b -> do
220+ Done 0 b ->
220− return $ Done (arrRem + n) b
221+ return $ ChunkDone nextOff b
222+ Done 1 b ->
223+ return $ ChunkDone curOff b
224+ Done n b ->
225+ return $ ChunkDone ((back n - start) `div` elemSize) b
226+ Partial 0 pst1 ->
227+ go SPEC next pst1
228+ Partial 1 pst1 ->
229+ go SPEC cur pst1
221 Partial n pst1 ->
230 Partial n pst1 ->
222− partial arrRem cur next elemSize Partial n pst1
231+ onBack (back n) elemSize ChunkPartial pst1
223− Continue n pst1 -> do
232+ Continue 0 pst1 ->
224− partial arrRem cur next elemSize Continue n pst1
233+ go SPEC next pst1
234+ Continue 1 pst1 ->
235+ go SPEC cur pst1
236+ Continue n pst1 ->
237+ onBack (back n) elemSize ChunkContinue pst1
225− Error err -> return $ Error err
238+ Error err ->
239+ return $ ChunkError curOff err
226
240
227−{-# INLINE_NORMAL parseDToK #-}
241+{-# INLINE parseDToK #-}
228parseDToK
242parseDToK
229− :: (MonadIO m, Unbox a)
243+ :: forall m a s b r. (MonadIO m, Unbox a)
230 => (s -> a -> m (Step s b))
244 => (s -> a -> m (Step s b))
231 -> m (Initial s b)
245 -> m (Initial s b)
232 -> (s -> m (Step s b))
246 -> (s -> m (Step s b))
233 -> Int
247 -> Int
234− -> (Int, Int)
248+ -> Int
235− -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))
249+ -> Maybe (Array a)
250+ -> (K.ParseResult b -> Int -> Maybe (Array a) -> m (K.Step a m r))
236− -> m (K.Step m a r)
251+ -> m (K.Step a m r)
237−-- Non 'Alternative' case.
238−parseDToK pstep initial extract leftover (0, _) cont = do
252+parseDToK pstep initial extract offset usedCount input cont = do
239 res <- initial
253 res <- initial
240 case res of
254 case res of
241− IPartial r -> return $ K.Partial leftover (parseCont (return r))
255+ IPartial pst -> do
256+ case input of
257+ Just arr -> parseContJust usedCount offset pst arr
258+ Nothing -> parseContNothing usedCount pst
242− IDone b -> cont state (K.Success 0 b)
259+ IDone b -> cont (K.Success offset b) usedCount input
243− IError err -> cont state (K.Failure err)
260+ IError err -> cont (K.Failure offset err) usedCount input
244
261
245 where
262 where
246
263
247− -- The continuation is called with (0,0) state i.e. Alternative level
264+ -- XXX We can maintain an absolute position instead of relative that will
248− -- is 0 and the used count is 0. Alternative level is 0 because the level
265+ -- help in reporting of error location in the stream.
249− -- passed in the argument above is 0, the "used" count is 0 because it is
266+ {-# NOINLINE parseContJust #-}
250− -- not useful when Alternative level is 0. We should probably use a Maybe
267+ parseContJust count off pst arr = do
251− -- type for the state but that might impact performance, need to measure.
252− state = (0,0)
253−
254− -- We could pass a stream or array here and drive the ParserD with fusion.
255− parseCont pst (Just arr) = do
256− r <- pst
257− pRes <- parseChunk pstep r arr
268+ pRes <- parseChunk pstep pst arr off
269+ -- The "n" here is stream position index wrt the array start, and not
270+ -- the backtrack count as returned by byte stream parsers.
258 case pRes of
271 case pRes of
259− Done n b -> cont state (K.Success n b)
272+ ChunkDone n b ->
260− Error err -> cont state (K.Failure err)
273+ assert (n <= Array.length arr)
261− Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))
274+ (cont (K.Success n b) (count + n - off) (Just arr))
262− Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
275+ ChunkPartial n pst1 ->
276+ assert (n < 0 || n >= Array.length arr)
277+ (return $ K.Partial n (parseCont (count + n - off) pst1))
278+ ChunkContinue n pst1 ->
279+ assert (n < 0 || n >= Array.length arr)
280+ (return $ K.Continue n (parseCont (count + n - off) pst1))
281+ ChunkError n err ->
282+ cont (K.Failure n err) (count + n - off) (Just arr)
263
283
264− parseCont acc Nothing = do
284+ {-# NOINLINE parseContNothing #-}
265− pst <- acc
285+ parseContNothing count pst = do
266 r <- extract pst
286 r <- extract pst
267 case r of
287 case r of
268− Done n b -> cont state (K.Success n b)
288+ -- IMPORTANT: the n here is from the byte stream parser, that means
269− Error err -> cont state (K.Failure err)
289+ -- it is the backtrack element count and not the stream position
270− Partial _ _ -> error "Bug: parseDToK Partial unreachable"
290+ -- index into the current input array.
271− Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
291+ Done n b ->
272−
292+ assert (n >= 0)
273−-- 'Alternative' case. Used count needs to be maintained when inside an
274−-- Alternative.
275−parseDToK pstep initial extract leftover (level, count) cont = do
276− res <- initial
277− case res of
278− IPartial r -> return $ K.Partial leftover (parseCont count (return r))
279− IDone b -> cont (level,count) (K.Success 0 b)
293+ (cont (K.Success (- n) b) (count - n) Nothing)
280− IError err -> cont (level,count) (K.Failure err)
294+ Continue n pst1 ->
281−
295+ assert (n >= 0)
282− where
296+ (return $ K.Continue (- n) (parseCont (count - n) pst1))
283−
284− parseCont !cnt pst (Just arr) = do
285− let !cnt1 = cnt + Array.length arr
286− r <- pst
287− pRes <- parseChunk pstep r arr
288− case pRes of
289− Done n b -> do
290− assertM(n <= cnt1)
291− cont (level, cnt1 - n) (K.Success n b)
292 Error err ->
297 Error err ->
298+ -- XXX It is called only when there is no input arr. So using 0
299+ -- as the position is correct?
293− cont (level, cnt1) (K.Failure err)
300+ cont (K.Failure 0 err) count Nothing
294− Partial n pst1 -> do
295− assertM(n <= cnt1)
296− return $ K.Partial n (parseCont (cnt1 - n) (return pst1))
297− Continue n pst1 -> do
298− assertM(n <= cnt1)
299− return $ K.Continue n (parseCont (cnt1 - n) (return pst1))
300− parseCont cnt acc Nothing = do
301− pst <- acc
302− r <- extract pst
303− let s = (level, cnt)
304− case r of
305− Done n b -> do
306− assertM(n <= cnt)
307− cont s (K.Success n b)
308 Partial _ _ -> error "Bug: parseDToK Partial unreachable"
301 Partial _ _ -> error "Bug: parseDToK Partial unreachable"
309− Error e ->
302+
310− cont s (K.Failure e)
303+ -- XXX Maybe we can use two separate continuations instead of using
311− Continue n pst1 -> do
304+ -- Just/Nothing cases here. That may help in avoiding the parseContJust
312− assertM(n <= cnt)
305+ -- function call.
313− return $ K.Continue n (parseCont (cnt - n) (return pst1))
306+ {-# INLINE parseCont #-}
307+ parseCont cnt pst (Just arr) = parseContJust cnt 0 pst arr
308+ parseCont cnt pst Nothing = parseContNothing cnt pst
314
309
315-- | Convert a raw byte 'Parser' to a chunked parser.
310-- | Convert a raw byte 'Parser' to a chunked parser.
316--
311--
core/src/Streamly/Internal/Data/Parser/Chunked/Type.hs+73−56
@@ -25,7 +25,7 @@
25module Streamly.Internal.Data.Parser.Chunked.Type
25module Streamly.Internal.Data.Parser.Chunked.Type
26 (
26 (
27 Step (..)
27 Step (..)
28− , Parse (..)
28+ , ParseResult (..)
29 , ParserChunked (..)
29 , ParserChunked (..)
30 , fromPure
30 , fromPure
31 , fromEffect
31 , fromEffect
@@ -52,34 +52,47 @@ import qualified Control.Monad.Fail as Fail
52--
52--
53-- /Pre-release/
53-- /Pre-release/
54--
54--
55−data Step m a r =
55+data Step a m r =
56+ -- The Int is the current stream position index wrt to the start of the
57+ -- array.
56 Done !Int r
58 Done !Int r
57 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
59 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
58 -- measure if that works any better.
60 -- measure if that works any better.
61+ -- Array a -> m (Step a m r), m (Step a m r)
59 -- XXX The Array is the only difference from element parser, we can pass
62 -- XXX The Array is the only difference from element parser, we can pass
60 -- this as parameter?
63 -- this as parameter?
61− | Partial !Int (Maybe (Array a) -> m (Step m a r))
64+ | Partial !Int (Maybe (Array a) -> m (Step a m r))
62− | Continue !Int (Maybe (Array a) -> m (Step m a r))
65+ | Continue !Int (Maybe (Array a) -> m (Step a m r))
63− | Error String
66+ | Error !Int String
64
67
65−instance Functor m => Functor (Step m a) where
68+instance Functor m => Functor (Step a m) where
66 fmap f (Done n r) = Done n (f r)
69 fmap f (Done n r) = Done n (f r)
67 fmap f (Partial n k) = Partial n (fmap (fmap f) . k)
70 fmap f (Partial n k) = Partial n (fmap (fmap f) . k)
68 fmap f (Continue n k) = Continue n (fmap (fmap f) . k)
71 fmap f (Continue n k) = Continue n (fmap (fmap f) . k)
69− fmap _ (Error e) = Error e
72+ fmap _ (Error n e) = Error n e
70
73
71-- | The parser's result.
74-- | The parser's result.
72--
75--
76+-- Int is the position index into the current input array. Could be negative.
77+-- Cannot be beyond the input array max bound.
78+--
73-- /Pre-release/
79-- /Pre-release/
74--
80--
75−data Parse b =
81+data ParseResult b =
76− Success !Int !b -- Leftover count, result
82+ Success !Int !b -- Position index, result
77− | Failure !String -- Error
83+ | Failure !Int !String -- Position index, error
78
84
79-- | Map a function over 'Success'.
85-- | Map a function over 'Success'.
80−instance Functor Parse where
86+instance Functor ParseResult where
81 fmap f (Success n b) = Success n (f b)
87 fmap f (Success n b) = Success n (f b)
82− fmap _ (Failure e) = Failure e
88+ fmap _ (Failure n e) = Failure n e
89+
90+-- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r
91+--
92+-- The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)
93+-- The extract continuation would be: m (Step a m r) -> m (Step a m r)
94+--
95+-- Use Step itself in place of ParseResult.
83
96
84-- | A continuation passing style parser representation. A continuation of
97-- | A continuation passing style parser representation. A continuation of
85-- 'Step's, each step passes a state and a parse result to the next 'Step'. The
98-- 'Step's, each step passes a state and a parse result to the next 'Step'. The
@@ -90,24 +103,27 @@ instance Functor Parse where
90--
103--
91newtype ParserChunked a m b = MkParser
104newtype ParserChunked a m b = MkParser
92 { runParser :: forall r.
105 { runParser :: forall r.
93− -- leftover: the number of elements that were not used by the
106+ -- XXX Maintain and pass the original position in the stream. that
94− -- previous consumer and should be carried forward.
107+ -- way we can also report better errors. Use a Context structure for
108+ -- passing the state.
109+
110+ -- Stream position index wrt to the current input array start. If
111+ -- negative then backtracking is required before using the array.
112+ -- The parser should use "Continue -n" in this case if it needs to
113+ -- consume input. Negative value cannot be beyond the current
114+ -- backtrack buffer. Positive value cannot be beyond array length.
115+ -- If the parser needs to advance beyond the array length it should
116+ -- use "Continue +n".
95 Int
117 Int
96− -- (alt nesting level, alt used elem count). Nesting level is
97− -- increased whenever we enter an Alternative composition and
98− -- decreased when it is done. The used element count is a count of
99− -- elements consumed by the Alternative. If the Alternative fails we
118+ -- used elem count, a count of elements consumed by the parser. If
100− -- need to backtrack by this amount.
119+ -- an Alternative fails we need to backtrack by this amount.
101− --
102− -- The nesting level is used in parseDToK to optimize the case when
103− -- we are not in an alternative, in that case we do not need to
104− -- maintain the element count for backtracking.
105− -> (Int, Int)
120+ -> Int
106− -- The first argument is the (nest level, used count) tuple as
121+ -- The second argument is the used count as described above. The
107− -- described above. The leftover element count is carried as part of
122+ -- current input position is carried as part of 'Success'
108− -- 'Success' constructor of 'Parse'.
123+ -- constructor of 'ParseResult'.
109− -> ((Int, Int) -> Parse b -> m (Step m a r))
124+ -> Maybe (Array a)
125+ -> (ParseResult b -> Int -> Maybe (Array a) -> m (Step a m r))
110− -> m (Step m a r)
126+ -> m (Step a m r)
111 }
127 }
112
128
113-------------------------------------------------------------------------------
129-------------------------------------------------------------------------------
@@ -119,9 +135,9 @@ newtype ParserChunked a m b = MkParser
119--
135--
120instance Functor m => Functor (ParserChunked a m) where
136instance Functor m => Functor (ParserChunked a m) where
121 {-# INLINE fmap #-}
137 {-# INLINE fmap #-}
122− fmap f parser = MkParser $ \n st k ->
138+ fmap f parser = MkParser $ \n st arr pk ->
123− let k1 s res = k s (fmap f res)
139+ let pk1 res = pk (fmap f res)
124− in runParser parser n st k1
140+ in runParser parser n st arr pk1
125
141
126-------------------------------------------------------------------------------
142-------------------------------------------------------------------------------
127-- Sequential applicative
143-- Sequential applicative
@@ -135,7 +151,7 @@ instance Functor m => Functor (ParserChunked a m) where
135--
151--
136{-# INLINE fromPure #-}
152{-# INLINE fromPure #-}
137fromPure :: b -> ParserChunked a m b
153fromPure :: b -> ParserChunked a m b
138−fromPure b = MkParser $ \n st k -> k st (Success n b)
154+fromPure b = MkParser $ \n st arr pk -> pk (Success n b) st arr
139
155
140-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
156-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
141--
157--
@@ -143,7 +159,8 @@ fromPure b = MkParser $ \n st k -> k st (Success n b)
143--
159--
144{-# INLINE fromEffect #-}
160{-# INLINE fromEffect #-}
145fromEffect :: Monad m => m b -> ParserChunked a m b
161fromEffect :: Monad m => m b -> ParserChunked a m b
162+fromEffect eff =
146−fromEffect eff = MkParser $ \n st k -> eff >>= \b -> k st (Success n b)
163+ MkParser $ \n st arr pk -> eff >>= \b -> pk (Success n b) st arr
147
164
148-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that
165-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that
149-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'
166-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'
@@ -157,19 +174,19 @@ instance Monad m => Applicative (ParserChunked a m) where
157 (<*>) = ap
174 (<*>) = ap
158
175
159 {-# INLINE (*>) #-}
176 {-# INLINE (*>) #-}
160− p1 *> p2 = MkParser $ \n st k ->
177+ p1 *> p2 = MkParser $ \n st arr k ->
161− let k1 s (Success n1 _) = runParser p2 n1 s k
178+ let k1 (Success n1 _) s input = runParser p2 n1 s input k
162− k1 s (Failure e) = k s (Failure e)
179+ k1 (Failure n1 e) s input = k (Failure n1 e) s input
163− in runParser p1 n st k1
180+ in runParser p1 n st arr k1
164
181
165 {-# INLINE (<*) #-}
182 {-# INLINE (<*) #-}
166− p1 <* p2 = MkParser $ \n st k ->
183+ p1 <* p2 = MkParser $ \n st arr k ->
167− let k1 s1 (Success n1 b) =
184+ let k1 (Success n1 b) s1 input =
168− let k2 s2 (Success n2 _) = k s2 (Success n2 b)
185+ let k2 (Success n2 _) = k (Success n2 b)
169− k2 s2 (Failure e) = k s2 (Failure e)
186+ k2 (Failure n2 e) = k (Failure n2 e)
170− in runParser p2 n1 s1 k2
187+ in runParser p2 n1 s1 input k2
171− k1 s1 (Failure e) = k s1 (Failure e)
188+ k1 (Failure n1 e) s1 input = k (Failure n1 e) s1 input
172− in runParser p1 n st k1
189+ in runParser p1 n st arr k1
173
190
174 {-# INLINE liftA2 #-}
191 {-# INLINE liftA2 #-}
175 liftA2 f p = (<*>) (fmap f p)
192 liftA2 f p = (<*>) (fmap f p)
@@ -187,7 +204,7 @@ instance Monad m => Applicative (ParserChunked a m) where
187--
204--
188{-# INLINE die #-}
205{-# INLINE die #-}
189die :: String -> ParserChunked a m b
206die :: String -> ParserChunked a m b
190−die err = MkParser (\_ st k -> k st (Failure err))
207+die err = MkParser (\n st arr pk -> pk (Failure n err) st arr)
191
208
192-- | Monad composition can be used for lookbehind parsers, we can make the
209-- | Monad composition can be used for lookbehind parsers, we can make the
193-- future parses depend on the previously parsed values.
210-- future parses depend on the previously parsed values.
@@ -236,10 +253,10 @@ instance Monad m => Monad (ParserChunked a m) where
236 return = pure
253 return = pure
237
254
238 {-# INLINE (>>=) #-}
255 {-# INLINE (>>=) #-}
239− p >>= f = MkParser $ \n st k ->
256+ p >>= f = MkParser $ \n st arr pk ->
240− let k1 s1 (Success n1 b) = runParser (f b) n1 s1 k
257+ let pk1 (Success n1 b) s1 inp = runParser (f b) n1 s1 inp pk
241− k1 s1 (Failure e) = k s1 (Failure e)
258+ pk1 (Failure n1 e) s1 inp = pk (Failure n1 e) s1 inp
242− in runParser p n st k1
259+ in runParser p n st arr pk1
243
260
244 {-# INLINE (>>) #-}
261 {-# INLINE (>>) #-}
245 (>>) = (*>)
262 (>>) = (*>)
@@ -261,7 +278,7 @@ instance (MonadThrow m, MonadReader r m, MonadCatch m) =>
261 ask = fromEffect ask
278 ask = fromEffect ask
262
279
263 {-# INLINE local #-}
280 {-# INLINE local #-}
264− local f p = MkParser $ \n st k -> local f $ runParser p n st k
281+ local f p = MkParser $ \n st arr k -> local f $ runParser p n st arr k
265
282
266instance (MonadThrow m, MonadState s m) => MonadState s (ParserChunked a m) where
283instance (MonadThrow m, MonadState s m) => MonadState s (ParserChunked a m) where
267 {-# INLINE get #-}
284 {-# INLINE get #-}
@@ -296,11 +313,11 @@ instance Monad m => Alternative (ParserChunked a m) where
296 empty = die "empty"
313 empty = die "empty"
297
314
298 {-# INLINE (<|>) #-}
315 {-# INLINE (<|>) #-}
299− p1 <|> p2 = MkParser $ \n (level, _) k ->
316+ p1 <|> p2 = MkParser $ \n _ arr k ->
300− let k1 (0, _) _ = error "Bug: 0 nest level in Alternative"
317+ let
301− k1 (l1, n1) (Failure _) = runParser p2 n1 (l1 - 1, 0) k
318+ k1 (Failure pos _) used input = runParser p2 (pos - used) 0 input k
302− k1 (l1, _) success = k (l1 - 1, 0) success
319+ k1 success _ input = k success 0 input
303− in runParser p1 n (level + 1, 0) k1
320+ in runParser p1 n 0 arr k1
304
321
305 -- some and many are implemented here instead of using default definitions
322 -- some and many are implemented here instead of using default definitions
306 -- so that we can use INLINE on them. It gives 50% performance improvement.
323 -- so that we can use INLINE on them. It gives 50% performance improvement.
test/Streamly/Test/Data/Parser/Chunked.hs+2−2
@@ -700,7 +700,7 @@ applicative =
700 in monadicIO $ do
700 in monadicIO $ do
701 let arrays = [A.fromList list1, A.fromList list2]
701 let arrays = [A.fromList list1, A.fromList list2]
702 (olist1, olist2) <-
702 (olist1, olist2) <-
703− run $ parse (P.fromRaw parser) (S.fromList arrays)
703+ run $ parse (P.fromParserD parser) (S.fromList arrays)
704 listEquals (==) olist1 list1
704 listEquals (==) olist1 list1
705 listEquals (==) olist2 list2
705 listEquals (==) olist2 list2
706
706
@@ -728,7 +728,7 @@ monad =
728 in monadicIO $ do
728 in monadicIO $ do
729 let arrays = [A.fromList list1, A.fromList list2]
729 let arrays = [A.fromList list1, A.fromList list2]
730 (olist1, olist2) <-
730 (olist1, olist2) <-
731− run $ parse (P.fromRaw parser) (S.fromList arrays)
731+ run $ parse (P.fromParserD parser) (S.fromList arrays)
732 listEquals (==) olist1 list1
732 listEquals (==) olist1 list1
733 listEquals (==) olist2 list2
733 listEquals (==) olist2 list2
734
734