443614f · streamly · git.iko.soy

git.iko.soy/streamly

Add strictness annotations in chunked parser

Resulted in significant performance improvements.

commit443614fe793b2ff8961b2a1ce87d557d79312f0b authorHarendra Kumar <harendra@composewell.com> dateWed 15 Feb 2023, 12:19 (4 years ago) parent83f1738

3 files changed+27−17

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+15−6 core/src/Streamly/Data/Stream/StreamK.hs+1 core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+11−11

benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+15−6

@@ -58,7 +58,11 @@ benchIOSink

5858 :: NFData b

5959 => Int -> String -> (StreamK IO (Array Int) -> IO b) -> Benchmark

6060benchIOSink value name f =

61− bench name $ nfIO $ randomRIO (1,1) >>= f . StreamK.fromStream . Stream.arraysOf 32000 . sourceUnfoldrM value

61+ bench name $ nfIO $ randomRIO (1,1)

62+ >>= f

63+ . StreamK.fromStream

64+ . Stream.arraysOf 4000

65+ . sourceUnfoldrM value

6266

6367-------------------------------------------------------------------------------

6468-- Parsers

@@ -67,7 +71,8 @@ benchIOSink value name f =

6771#define PARSE_OP StreamK.parseKChunks

6872

6973{-# INLINE one #-}

70−one :: MonadIO m => Int -> StreamK m (Array Int) -> m (Either ParseError (Maybe Int))

74+one :: MonadIO m =>

75+ Int -> StreamK m (Array Int) -> m (Either ParseError (Maybe Int))

7176one value = StreamK.parseKChunks p

7277

7378 where

@@ -87,7 +92,8 @@ takeWhile :: (MonadIO m, Unbox a) => (a -> Bool) -> PR.Parser a m ()

8792takeWhile p = PR.fromParser $ PRD.takeWhile p FL.drain

8893

8994{-# INLINE takeWhileK #-}

90−takeWhileK :: MonadIO m => Int -> StreamK m (Array Int) -> m (Either ParseError ())

95+takeWhileK :: MonadIO m =>

96+ Int -> StreamK m (Array Int) -> m (Either ParseError ())

9197takeWhileK value = PARSE_OP (takeWhile (<= value))

9298

9399{-# INLINE splitApp #-}

@@ -105,7 +111,8 @@ sequenceA value xs = do

105111 return $ Prelude.length x

106112

107113{-# INLINE sequenceA_ #-}

108−sequenceA_ :: MonadIO m => Int -> StreamK m (Array Int) -> m (Either ParseError ())

114+sequenceA_ :: MonadIO m =>

115+ Int -> StreamK m (Array Int) -> m (Either ParseError ())

109116sequenceA_ value xs = do

110117 let parser = satisfy (> 0)

111118 list = Prelude.replicate value parser

@@ -120,7 +127,8 @@ sequence value xs = do

120127 return $ Prelude.length x

121128

122129{-# INLINE sequence_ #-}

123−sequence_ :: MonadIO m => Int -> StreamK m (Array Int) -> m (Either ParseError ())

130+sequence_ :: MonadIO m =>

131+ Int -> StreamK m (Array Int) -> m (Either ParseError ())

124132sequence_ value =

125133 let parser = satisfy (> 0)

126134 list = Prelude.replicate value parser

@@ -139,7 +147,8 @@ someAlt xs = do

139147 return $ Prelude.length x

140148

141149{-# INLINE choice #-}

142−choice :: MonadIO m => Int -> StreamK m (Array Int) -> m (Either ParseError Int)

150+choice :: MonadIO m =>

151+ Int -> StreamK m (Array Int) -> m (Either ParseError Int)

143152choice value =

144153 PARSE_OP (asum (replicate value (satisfy (< 0)))

145154 AP.<|> satisfy (> 0))

core/src/Streamly/Data/Stream/StreamK.hs+1

@@ -54,6 +54,7 @@ module Streamly.Data.Stream.StreamK

5454 -- ** Parsing

5555 -- , parseBreak

5656 , parseKBreakChunks

57+ -- , parseKChunks

5758

5859 -- * Combining Two Streams

5960 -- ** Appending

core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+11−11

@@ -366,7 +366,7 @@ parseChunk

366366 -> Array a

367367 -> Int

368368 -> m (ChunkResult s b)

369−parseChunk pstep state (Array contents start end) offset = do

369+parseChunk pstep !state (Array contents start end) !offset = do

370370 if offset >= 0

371371 then go SPEC (start + offset * SIZE_OF(a)) state

372372 else return $ ChunkContinue offset state

@@ -427,7 +427,7 @@ parseDToK

427427 -> Input a

428428 -> (ParseResult b -> Int -> Input a -> m (Step a m r))

429429 -> m (Step a m r)

430−parseDToK pstep initial extract offset usedCount input cont = do

430+parseDToK pstep initial extract !offset !usedCount !input cont = do

431431 res <- initial

432432 case res of

433433 ParserD.IPartial pst -> do

@@ -442,7 +442,7 @@ parseDToK pstep initial extract offset usedCount input cont = do

442442 -- XXX We can maintain an absolute position instead of relative that will

443443 -- help in reporting of error location in the stream.

444444 {-# NOINLINE parseContChunk #-}

445− parseContChunk count off pst arr = do

445+ parseContChunk !count !off !pst !arr = do

446446 pRes <- parseChunk pstep pst arr off

447447 -- The "n" here is stream position index wrt the array start, and not

448448 -- the backtrack count as returned by byte stream parsers.

@@ -452,15 +452,15 @@ parseDToK pstep initial extract offset usedCount input cont = do

452452 (cont (Success n b) (count + n - off) (Chunk arr))

453453 ChunkPartial n pst1 ->

454454 assert (n < 0 || n >= Array.length arr)

455− (return $ Partial n (parseCont (count + n - off) pst1))

455+ (return $ Partial n (parseCont SPEC (count + n - off) pst1))

456456 ChunkContinue n pst1 ->

457457 assert (n < 0 || n >= Array.length arr)

458− (return $ Continue n (parseCont (count + n - off) pst1))

458+ (return $ Continue n (parseCont SPEC (count + n - off) pst1))

459459 ChunkError n err ->

460460 cont (Failure n err) (count + n - off) (Chunk arr)

461461

462462 {-# NOINLINE parseContNothing #-}

463− parseContNothing count pst = do

463+ parseContNothing !count !pst = do

464464 r <- extract pst

465465 case r of

466466 -- IMPORTANT: the n here is from the byte stream parser, that means

@@ -471,7 +471,7 @@ parseDToK pstep initial extract offset usedCount input cont = do

471471 (cont (Success (- n) b) (count - n) None)

472472 ParserD.Continue n pst1 ->

473473 assert (n >= 0)

474− (return $ Continue (- n) (parseCont (count - n) pst1))

474+ (return $ Continue (- n) (parseCont SPEC (count - n) pst1))

475475 ParserD.Error err ->

476476 -- XXX It is called only when there is no input arr. So using 0

477477 -- as the position is correct?

@@ -482,10 +482,10 @@ parseDToK pstep initial extract offset usedCount input cont = do

482482 -- Just/Nothing cases here. That may help in avoiding the parseContJust

483483 -- function call.

484484 {-# INLINE parseCont #-}

485− parseCont cnt pst (Chunk arr) = parseContChunk cnt 0 pst arr

486− parseCont cnt pst None = parseContNothing cnt pst

485+ parseCont _ !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr

486+ parseCont _ !cnt !pst None = parseContNothing cnt pst

487487

488−-- | Convert a raw byte 'Parser' to a chunked parser.

488+-- | Convert a raw byte 'Parser' to a chunked 'ParserK'.

489489--

490490-- /Pre-release/

491491--

@@ -540,4 +540,4 @@ toParser parser = ParserD.Parser step initial extract

540540{-# RULES "toParser/fromParser fusion" [2]

541541 forall s. fromParser (toParser s) = s #-}

542542#endif

543− -}

543+-}