443614f · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add strictness annotations in chunked parser

443614fHarendra Kumar4 years ago

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

compare with master

unifiedsplit

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

58 :: NFData b

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

60benchIOSink 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

63-------------------------------------------------------------------------------

67-------------------------------------------------------------------------------

64-- Parsers

68-- Parsers

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

67#define PARSE_OP StreamK.parseKChunks

71#define PARSE_OP StreamK.parseKChunks

69{-# INLINE one #-}

73{-# INLINE one #-}

74+one :: MonadIO m =>

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

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

71one value = StreamK.parseKChunks p

76one value = StreamK.parseKChunks p

73 where

78 where

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

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

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

89{-# INLINE takeWhileK #-}

94{-# INLINE takeWhileK #-}

95+takeWhileK :: MonadIO m =>

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

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

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

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

93{-# INLINE splitApp #-}

99{-# INLINE splitApp #-}

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

105 return $ Prelude.length x

111 return $ Prelude.length x

106

112

107{-# INLINE sequenceA_ #-}

113{-# INLINE sequenceA_ #-}

114+sequenceA_ :: MonadIO m =>

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

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

109sequenceA_ value xs = do

116sequenceA_ value xs = do

110 let parser = satisfy (> 0)

117 let parser = satisfy (> 0)

111 list = Prelude.replicate value parser

118 list = Prelude.replicate value parser

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

120 return $ Prelude.length x

127 return $ Prelude.length x

121

128

122{-# INLINE sequence_ #-}

129{-# INLINE sequence_ #-}

130+sequence_ :: MonadIO m =>

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

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

124sequence_ value =

132sequence_ value =

125 let parser = satisfy (> 0)

133 let parser = satisfy (> 0)

126 list = Prelude.replicate value parser

134 list = Prelude.replicate value parser

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

139 return $ Prelude.length x

147 return $ Prelude.length x

140

148

141{-# INLINE choice #-}

149{-# INLINE choice #-}

150+choice :: MonadIO m =>

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

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

143choice value =

152choice value =

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

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

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

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

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

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

54 -- ** Parsing

55 -- , parseBreak

56 , parseKBreakChunks

57+ -- , parseKChunks

58 -- * Combining Two Streams

59 -- * Combining Two Streams

59 -- ** Appending

60 -- ** Appending

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

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

366 -> Array a

367 -> Int

368 -> m (ChunkResult s b)

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

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

370 if offset >= 0

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

372 else return $ ChunkContinue offset state

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

427 -> Input a

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

429 -> 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

431 res <- initial

432 case res of

433 ParserD.IPartial pst -> do

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

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

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

444 {-# NOINLINE parseContChunk #-}

445− parseContChunk count off pst arr = do

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

446 pRes <- parseChunk pstep pst arr off

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

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

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

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

453 ChunkPartial n pst1 ->

454 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))

456 ChunkContinue n pst1 ->

457 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))

459 ChunkError n err ->

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

461

462 {-# NOINLINE parseContNothing #-}

463− parseContNothing count pst = do

463+ parseContNothing !count !pst = do

464 r <- extract pst

465 case r of

466 -- 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

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

472 ParserD.Continue n pst1 ->

473 assert (n >= 0)

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

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

475 ParserD.Error err ->

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

477 -- as the position is correct?

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

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

483 -- function call.

484 {-# INLINE parseCont #-}

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

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

486− parseCont cnt pst None = parseContNothing cnt pst

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

487

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

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

489--

490-- /Pre-release/

491--

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

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

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

542#endif

543− -}

543+-}