on master help sign in
Refactor parseDToK for better optimization
commit53e6fc48715e6afeb148defb8e7199dd575bf5a1 authorHarendra Kumar <harendra@composewell.com> dateTue 28 Feb 2023, 13:44 (4 years ago) parentebb3059
2 files changed+82−85
core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+75−85 core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+7
core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+75−85
@@ -358,71 +358,6 @@ instance MonadTrans (ParserK a) where
358358-- Convert ParserD to ParserK
359359-------------------------------------------------------------------------------
360360
361−data ChunkResult s b =
362− ChunkDone !Int !b
363− | ChunkPartial !Int !s
364− | ChunkContinue !Int !s
365− | ChunkError !Int String
366−
367−-- This is very similar to fromParserD in the Array/Unboxed/Fold module.
368−{-# INLINE parseChunk #-}
369−parseChunk
370− :: forall m a s b. (Monad m, Unbox a)
371− => (s -> a -> m (ParserD.Step s b))
372− -> s
373− -> Array a
374− -> Int
375− -> m (ChunkResult s b)
376−parseChunk pstep !state (Array contents start end) !offset = do
377− if offset >= 0
378− then go SPEC (start + offset * SIZE_OF(a)) state
379− else return $ ChunkContinue offset state
380−
381− where
382−
383− {-# INLINE onBack #-}
384− onBack offset1 elemSize constr pst = do
385− let pos = offset1 - start
386− in if pos >= 0
387− then go SPEC offset1 pst
388− else return $ constr (pos `div` elemSize) pst
389−
390− -- Note: div may be expensive but the alternative is to maintain an element
391− -- offset in addition to a byte offset or just the element offset and use
392− -- multiplication to get the byte offset every time, both these options
393− -- turned out to be more expensive than using div.
394− go !_ !cur !pst | cur >= end =
395− return $ ChunkContinue ((end - start) `div` SIZE_OF(a)) pst
396− go !_ !cur !pst = do
397− let !x = unsafeInlineIO $ peekWith contents cur
398− pRes <- pstep pst x
399− let elemSize = SIZE_OF(a)
400− next = INDEX_NEXT(cur,a)
401− back n = next - n * elemSize
402− curOff = (cur - start) `div` elemSize
403− nextOff = (next - start) `div` elemSize
404− case pRes of
405− ParserD.Done 0 b ->
406− return $ ChunkDone nextOff b
407− ParserD.Done 1 b ->
408− return $ ChunkDone curOff b
409− ParserD.Done n b ->
410− return $ ChunkDone ((back n - start) `div` elemSize) b
411− ParserD.Partial 0 pst1 ->
412− go SPEC next pst1
413− ParserD.Partial 1 pst1 ->
414− go SPEC cur pst1
415− ParserD.Partial n pst1 ->
416− onBack (back n) elemSize ChunkPartial pst1
417− ParserD.Continue 0 pst1 ->
418− go SPEC next pst1
419− ParserD.Continue 1 pst1 ->
420− go SPEC cur pst1
421− ParserD.Continue n pst1 ->
422− onBack (back n) elemSize ChunkContinue pst1
423− ParserD.Error err ->
424− return $ ChunkError curOff err
425−
426361{-# INLINE parseDToK #-}
427362parseDToK
428363 :: forall m a s b r. (Monad m, Unbox a)
@@ -434,37 +369,92 @@ parseDToK
434369 -> Int
435370 -> Input a
436371 -> m (Step a m r)
437−parseDToK pstep initial extract cont !offset !usedCount !input = do
372+parseDToK pstep initial extract cont !offset0 !usedCount !input = do
438373 res <- initial
439374 case res of
440375 ParserD.IPartial pst -> do
441376 case input of
442− Chunk arr -> parseContChunk usedCount offset pst arr
377+ Chunk arr -> parseContChunk usedCount offset0 pst arr
443378 None -> parseContNothing usedCount pst
444− ParserD.IDone b -> cont (Success offset b) usedCount input
445− ParserD.IError err -> cont (Failure offset err) usedCount input
379+ ParserD.IDone b -> cont (Success offset0 b) usedCount input
380+ ParserD.IError err -> cont (Failure offset0 err) usedCount input
446381
447382 where
448383
449384 -- XXX We can maintain an absolute position instead of relative that will
450385 -- help in reporting of error location in the stream.
451386 {-# NOINLINE parseContChunk #-}
452− parseContChunk !count !off !pst !arr = do
453− pRes <- parseChunk pstep pst arr off
454− -- The "n" here is stream position index wrt the array start, and not
455− -- the backtrack count as returned by byte stream parsers.
456− case pRes of
457− ChunkDone n b ->
458− assert (n <= Array.length arr)
459− (cont (Success n b) (count + n - off) (Chunk arr))
460− ChunkPartial n pst1 ->
461− assert (n < 0 || n >= Array.length arr)
462− (return $ Partial n (parseCont (count + n - off) pst1))
463− ChunkContinue n pst1 ->
464− assert (n < 0 || n >= Array.length arr)
465− (return $ Continue n (parseCont (count + n - off) pst1))
466− ChunkError n err ->
467− cont (Failure n err) (count + n - off) (Chunk arr)
387+ parseContChunk !count !offset !state arr@(Array contents start end) = do
388+ if offset >= 0
389+ then go SPEC (start + offset * SIZE_OF(a)) state
390+ else return $ Continue offset (parseCont count state)
391+
392+ where
393+
394+ {-# INLINE onDone #-}
395+ onDone n b =
396+ assert (n <= Array.length arr)
397+ (cont (Success n b) (count + n - offset) (Chunk arr))
398+
399+ {-# INLINE callParseCont #-}
400+ callParseCont constr n pst1 =
401+ assert (n < 0 || n >= Array.length arr)
402+ (return $ constr n (parseCont (count + n - offset) pst1))
403+
404+ {-# INLINE onPartial #-}
405+ onPartial = callParseCont Partial
406+
407+ {-# INLINE onContinue #-}
408+ onContinue = callParseCont Continue
409+
410+ {-# INLINE onError #-}
411+ onError n err =
412+ cont (Failure n err) (count + n - offset) (Chunk arr)
413+
414+ {-# INLINE onBack #-}
415+ onBack offset1 elemSize constr pst = do
416+ let pos = offset1 - start
417+ in if pos >= 0
418+ then go SPEC offset1 pst
419+ else constr (pos `div` elemSize) pst
420+
421+ -- Note: div may be expensive but the alternative is to maintain an element
422+ -- offset in addition to a byte offset or just the element offset and use
423+ -- multiplication to get the byte offset every time, both these options
424+ -- turned out to be more expensive than using div.
425+ go !_ !cur !pst | cur >= end =
426+ onContinue ((end - start) `div` SIZE_OF(a)) pst
427+ go !_ !cur !pst = do
428+ let !x = unsafeInlineIO $ peekWith contents cur
429+ pRes <- pstep pst x
430+ let elemSize = SIZE_OF(a)
431+ next = INDEX_NEXT(cur,a)
432+ back n = next - n * elemSize
433+ curOff = (cur - start) `div` elemSize
434+ nextOff = (next - start) `div` elemSize
435+ -- The "n" here is stream position index wrt the array start, and
436+ -- not the backtrack count as returned by byte stream parsers.
437+ case pRes of
438+ ParserD.Done 0 b ->
439+ onDone nextOff b
440+ ParserD.Done 1 b ->
441+ onDone curOff b
442+ ParserD.Done n b ->
443+ onDone ((back n - start) `div` elemSize) b
444+ ParserD.Partial 0 pst1 ->
445+ go SPEC next pst1
446+ ParserD.Partial 1 pst1 ->
447+ go SPEC cur pst1
448+ ParserD.Partial n pst1 ->
449+ onBack (back n) elemSize onPartial pst1
450+ ParserD.Continue 0 pst1 ->
451+ go SPEC next pst1
452+ ParserD.Continue 1 pst1 ->
453+ go SPEC cur pst1
454+ ParserD.Continue n pst1 ->
455+ onBack (back n) elemSize onContinue pst1
456+ ParserD.Error err ->
457+ onError curOff err
468458
469459 {-# NOINLINE parseContNothing #-}
470460 parseContNothing !count !pst = do
core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+7
@@ -183,6 +183,13 @@ parseD parser strm = do
183183parse :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b)
184184parse = parseD
185185
186+-- XXX It may be a good idea to use constant sized chunks for backtracking. We
187+-- can take a byte stream but when we have to backtrack we create constant
188+-- sized chunks. We maintain one forward list and one backward list of constant
189+-- sized chunks, and a last backtracking offset. That way we just need lists of
190+-- contents and no need to maintain start/end pointers for individual arrays,
191+-- reducing bookkeeping work.
192+
186193-- | Run a 'Parse' over a stream and return rest of the Stream.
187194{-# INLINE_NORMAL parseBreakD #-}
188195parseBreakD