c8b9fac · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Move parse functions to Source module

c8b9facHarendra Kumar6 years ago

benchmark/Streamly/Benchmark/Data/Parser.hs+1−1

compare with master

unifiedsplit

@@ -251,7 +251,7 @@ parseManyUnfoldArrays count arrays = do

251 Source.producer

252 $ Producer.concat Producer.fromList Array.producer

253 let streamParser =

254− Producer.simplify (Producer.parseMany parser readSrc)

254+ Producer.simplify (Source.parseMany parser readSrc)

255 S.drain $ S.unfold streamParser src

256

257-------------------------------------------------------------------------------

benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+1−1

@@ -225,7 +225,7 @@ parseManyUnfoldArrays count arrays = do

225 Source.producer

226 $ Producer.concat Producer.fromList Array.producer

227 let streamParser =

228− Producer.simplify (Producer.parseManyD parser readSrc)

228+ Producer.simplify (Source.parseManyD parser readSrc)

229 S.drain $ S.unfold streamParser src

230

231-------------------------------------------------------------------------------

src/Streamly/Internal/Data/Producer.hs+4−151

@@ -6,12 +6,12 @@

6-- Stability : experimental

7-- Portability : GHC

8--

9−-- A 'Producer' is an 'Unfold' with an 'extract' function added to to extract

9+-- A 'Producer' is an 'Unfold' with an 'extract' function added to extract

10-- the state. It is more powerful but less general than an Unfold.

11--

12-- A 'Producer' represents steps of a loop generating a sequence of elements.

13-- While unfolds are closed representation of imperative loops with some opaque

14−-- internal state, producers are open loops with the state being accesible to

14+-- internal state, producers are open loops with the state being accessible to

15-- the user.

16--

17-- Unlike an unfold, which runs a loop till completion, a producer can be

@@ -24,12 +24,12 @@

24-- unecessary function calls can be avoided.

26module Streamly.Internal.Data.Producer

27− ( Unfold (..)

27+ ( Producer (..)

29 -- * Converting

30 , simplify

32− -- * Unfolds

32+ -- * Producers

33 , nil

34 , nilM

35 , unfoldrM

@@ -39,29 +39,16 @@ module Streamly.Internal.Data.Producer

39 -- * Combinators

40 , NestedLoop (..)

41 , concat

42− , parse

43− , parseMany

44− , parseManyD

45 )

42 )

46where

43where

48#include "inline.hs"

45#include "inline.hs"

50−import Control.Exception (assert)

51−import Control.Monad.Catch (MonadThrow, throwM)

52−import GHC.Exts (SpecConstrAnnotation(..))

53−import GHC.Types (SPEC(..))

54−import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))

55−import Streamly.Internal.Data.Producer.Source (Source)

56import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

47import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

57import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..))

48import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..))

58import Streamly.Internal.Data.SVar (defState)

49import Streamly.Internal.Data.SVar (defState)

59import Streamly.Internal.Data.Unfold.Types (Unfold(..))

50import Streamly.Internal.Data.Unfold.Types (Unfold(..))

61−import qualified Streamly.Internal.Data.Parser.ParserD as ParserD

62−import qualified Streamly.Internal.Data.Parser.ParserK.Types as ParserK

63−import qualified Streamly.Internal.Data.Producer.Source as Source

64−

65import Streamly.Internal.Data.Producer.Type

52import Streamly.Internal.Data.Producer.Type

66import Prelude hiding (concat)

53import Prelude hiding (concat)

@@ -99,137 +86,3 @@ fromStreamD = Producer step return return

99 Yield x s -> Yield x (Stream step1 s)

86 Yield x s -> Yield x (Stream step1 s)

100 Skip s -> Skip (Stream step1 s)

87 Skip s -> Skip (Stream step1 s)

101 Stop -> Stop

88 Stop -> Stop

102−

103−-------------------------------------------------------------------------------

104−-- Parsing

105−-------------------------------------------------------------------------------

106−

107−-- XXX This should probably be moved to the Source module?

108−--

109−-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need

110−-- to make a newtype.

111−{-# ANN type List NoSpecConstr #-}

112−newtype List a = List {getList :: [a]}

113−

114−{-# INLINE_NORMAL parseD #-}

115−parseD

116− :: MonadThrow m

117− => ParserD.Parser m a b

118− -> Producer m (Source s a) a

119− -> Source s a

120− -> m (b, Source s a)

121−parseD

122− (ParserD.Parser pstep initial extract)

123− (Producer ustep uinject uextract)

124− seed = do

125−

126− state <- uinject seed

127− initial >>= go SPEC state (List [])

128−

129− where

130−

131− -- XXX currently we are using a dumb list based approach for backtracking

132− -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.

133− -- That will allow us more efficient random back and forth movement.

134− {-# INLINE go #-}

135− go !_ st buf !pst = do

136− r <- ustep st

137− case r of

138− Yield x s -> do

139− pRes <- pstep pst x

140− case pRes of

141− Partial 0 pst1 -> go SPEC s (List []) pst1

142− Partial n pst1 -> do

143− assert (n <= length (x:getList buf)) (return ())

144− let src0 = Prelude.take n (x:getList buf)

145− src = Prelude.reverse src0

146− gobuf SPEC s (List []) (List src) pst1

147− Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1

148− Continue n pst1 -> do

149− assert (n <= length (x:getList buf)) (return ())

150− let (src0, buf1) = splitAt n (x:getList buf)

151− src = Prelude.reverse src0

152− gobuf SPEC s (List buf1) (List src) pst1

153− Done n b -> do

154− assert (n <= length (x:getList buf)) (return ())

155− let src0 = Prelude.take n (x:getList buf)

156− src = Prelude.reverse src0

157− s1 <- uextract s

158− return (b, Source.unread src s1)

159− Error err -> throwM $ ParseError err

160− Skip s -> go SPEC s buf pst

161− Stop -> do

162− b <- extract pst

163− -- XXX we should return the remaining buffer

164− return (b, Source.source Nothing)

165−

166− gobuf !_ s buf (List []) !pst = go SPEC s buf pst

167− gobuf !_ s buf (List (x:xs)) !pst = do

168− pRes <- pstep pst x

169− case pRes of

170− Partial 0 pst1 ->

171− gobuf SPEC s (List []) (List xs) pst1

172− Partial n pst1 -> do

173− assert (n <= length (x:getList buf)) (return ())

174− let src0 = Prelude.take n (x:getList buf)

175− src = Prelude.reverse src0 ++ xs

176− gobuf SPEC s (List []) (List src) pst1

177− Continue 0 pst1 ->

178− gobuf SPEC s (List (x:getList buf)) (List xs) pst1

179− Continue n pst1 -> do

180− assert (n <= length (x:getList buf)) (return ())

181− let (src0, buf1) = splitAt n (x:getList buf)

182− src = Prelude.reverse src0 ++ xs

183− gobuf SPEC s (List buf1) (List src) pst1

184− Done n b -> do

185− assert (n <= length (x:getList buf)) (return ())

186− let src0 = Prelude.take n (x:getList buf)

187− src = Prelude.reverse src0

188− s1 <- uextract s

189− return (b, Source.unread src s1)

190− Error err -> throwM $ ParseError err

191−

192−-- | Parse a resumable unfold returning the parsed value and the state of the

193−-- unfold which can be resumed later to unfold the remaining values.

194−--

195−-- /Internal/

196−{-# INLINE [3] parse #-}

197−parse

198− :: MonadThrow m

199− => ParserK.Parser m a b

200− -> Producer m (Source s a) a

201− -> Source s a

202− -> m (b, Source s a)

203−parse = parseD . ParserK.fromParserK

204−

205−-------------------------------------------------------------------------------

206−-- Nested parsing

207−-------------------------------------------------------------------------------

208−

209−{-# INLINE parseManyD #-}

210−parseManyD :: MonadThrow m =>

211− ParserD.Parser m a b

212− -> Producer m (Source x a) a

213− -> Producer m (Source x a) b

214−parseManyD parser reader = Producer step return return

215−

216− where

217−

218− {-# INLINE_LATE step #-}

219− step src = do

220− if Source.isEmpty src

221− then return Stop

222− else do

223− (b, s1) <- parseD parser reader src

224− return $ Yield b s1

225−

226−-- | Apply a parser repeatedly on an unfold to generate an unfold of parsed

227−-- values.

228−--

229−-- /Internal/

230−{-# INLINE parseMany #-}

231−parseMany :: MonadThrow m =>

232− ParserK.Parser m a b

233− -> Producer m (Source x a) a

234− -> Producer m (Source x a) b

235−parseMany parser = parseManyD (ParserK.fromParserK parser)

src/Streamly/Internal/Data/Producer/Source.hs+154−12

@@ -6,8 +6,8 @@

6-- Stability : experimental

7-- Portability : GHC

8--

9−-- A stream source which can be unfolded with some possibly buffered data.

9+-- A 'Source' is a seed that can be unfolded to a stream with a buffer. Allows

10−-- Allows to 'unread' data i.e. push unused data back to the source. This is

10+-- to 'unread' data i.e. push unused data back to the source buffer. This is

11-- useful in parsing applications with backtracking.

12--

@@ -23,25 +23,35 @@ module Streamly.Internal.Data.Producer.Source

23 -- * Consumption

24 , isEmpty

25 , producer

26+

27+ -- * Parsing

28+ , parse

29+ , parseMany

30+ , parseManyD

26 )

31 )

27where

32where

29#include "inline.hs"

34#include "inline.hs"

36+import Control.Exception (assert)

37+import Control.Monad.Catch (MonadThrow, throwM)

38+import GHC.Exts (SpecConstrAnnotation(..))

39+import GHC.Types (SPEC(..))

31−import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

40+import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))

32import Streamly.Internal.Data.Producer.Type (Producer(..))

41import Streamly.Internal.Data.Producer.Type (Producer(..))

42+import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

43+

44+import qualified Streamly.Internal.Data.Parser.ParserD as ParserD

45+import qualified Streamly.Internal.Data.Parser.ParserK.Types as ParserK

46+

33import Prelude hiding (read)

47import Prelude hiding (read)

35−-- XXX instead of a seed should we wrap a Producer in a source? Then we won't

36−-- have to supply a Producer for read.

37−--

38−-- | An unfold seed with some buffered data. It allows us to 'unread' or return

49+-- | A seed with a buffer. It allows us to 'unread' or return some data

39−-- some data after reading it. Useful in backtracked parsing.

50+-- after reading it. Useful in backtracked parsing.

40--

51--

41data Source a b = Source [b] (Maybe a)

52data Source a b = Source [b] (Maybe a)

43−-- | Make a source from a seed value. The buffer would start as empty. You can

54+-- | Make a source from a seed value. The buffer would start as empty.

44−-- use 'unread' to add to the buffer.

45--

55--

46-- /Internal/

56-- /Internal/

47source :: Maybe a -> Source a b

57source :: Maybe a -> Source a b

@@ -54,12 +64,13 @@ source = Source []

54unread :: [b] -> Source a b -> Source a b

64unread :: [b] -> Source a b -> Source a b

55unread xs (Source ys seed) = Source (xs ++ ys) seed

65unread xs (Source ys seed) = Source (xs ++ ys) seed

67+-- | Determine if the source is empty.

57isEmpty :: Source a b -> Bool

68isEmpty :: Source a b -> Bool

58isEmpty (Source [] Nothing) = True

69isEmpty (Source [] Nothing) = True

59isEmpty _ = False

70isEmpty _ = False

61−-- | An unfold to read from a 'Source'. If the buffer has data then it is read

72+-- | Convert a producer to a producer from a buffered source. Any buffered data

62−-- first and then the seed is unfolded using the supplied unfold.

73+-- is read first and then the seed is unfolded.

63--

74--

64-- /Internal/

75-- /Internal/

65{-# INLINE_NORMAL producer #-}

76{-# INLINE_NORMAL producer #-}

@@ -89,3 +100,134 @@ producer (Producer step1 inject1 extract1) = Producer step inject extract

100

90 extract (Left s) = Source [] . Just <$> extract1 s

101 extract (Left s) = Source [] . Just <$> extract1 s

91 extract (Right (xs, a)) = return $ Source xs a

102 extract (Right (xs, a)) = return $ Source xs a

103+

104+-------------------------------------------------------------------------------

105+-- Parsing

106+-------------------------------------------------------------------------------

107+

108+-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need

109+-- to make a newtype.

110+{-# ANN type List NoSpecConstr #-}

111+newtype List a = List {getList :: [a]}

112+

113+{-# INLINE_NORMAL parseD #-}

114+parseD

115+ :: MonadThrow m

116+ => ParserD.Parser m a b

117+ -> Producer m (Source s a) a

118+ -> Source s a

119+ -> m (b, Source s a)

120+parseD

121+ (ParserD.Parser pstep initial extract)

122+ (Producer ustep uinject uextract)

123+ seed = do

124+

125+ state <- uinject seed

126+ initial >>= go SPEC state (List [])

127+

128+ where

129+

130+ -- XXX currently we are using a dumb list based approach for backtracking

131+ -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.

132+ -- That will allow us more efficient random back and forth movement.

133+ {-# INLINE go #-}

134+ go !_ st buf !pst = do

135+ r <- ustep st

136+ case r of

137+ Yield x s -> do

138+ pRes <- pstep pst x

139+ case pRes of

140+ Partial 0 pst1 -> go SPEC s (List []) pst1

141+ Partial n pst1 -> do

142+ assert (n <= length (x:getList buf)) (return ())

143+ let src0 = Prelude.take n (x:getList buf)

144+ src = Prelude.reverse src0

145+ gobuf SPEC s (List []) (List src) pst1

146+ Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1

147+ Continue n pst1 -> do

148+ assert (n <= length (x:getList buf)) (return ())

149+ let (src0, buf1) = splitAt n (x:getList buf)

150+ src = Prelude.reverse src0

151+ gobuf SPEC s (List buf1) (List src) pst1

152+ Done n b -> do

153+ assert (n <= length (x:getList buf)) (return ())

154+ let src0 = Prelude.take n (x:getList buf)

155+ src = Prelude.reverse src0

156+ s1 <- uextract s

157+ return (b, unread src s1)

158+ Error err -> throwM $ ParseError err

159+ Skip s -> go SPEC s buf pst

160+ Stop -> do

161+ b <- extract pst

162+ return (b, unread (reverse $ getList buf) (source Nothing))

163+

164+ gobuf !_ s buf (List []) !pst = go SPEC s buf pst

165+ gobuf !_ s buf (List (x:xs)) !pst = do

166+ pRes <- pstep pst x

167+ case pRes of

168+ Partial 0 pst1 ->

169+ gobuf SPEC s (List []) (List xs) pst1

170+ Partial n pst1 -> do

171+ assert (n <= length (x:getList buf)) (return ())

172+ let src0 = Prelude.take n (x:getList buf)

173+ src = Prelude.reverse src0 ++ xs

174+ gobuf SPEC s (List []) (List src) pst1

175+ Continue 0 pst1 ->

176+ gobuf SPEC s (List (x:getList buf)) (List xs) pst1

177+ Continue n pst1 -> do

178+ assert (n <= length (x:getList buf)) (return ())

179+ let (src0, buf1) = splitAt n (x:getList buf)

180+ src = Prelude.reverse src0 ++ xs

181+ gobuf SPEC s (List buf1) (List src) pst1

182+ Done n b -> do

183+ assert (n <= length (x:getList buf)) (return ())

184+ let src0 = Prelude.take n (x:getList buf)

185+ src = Prelude.reverse src0

186+ s1 <- uextract s

187+ return (b, unread src s1)

188+ Error err -> throwM $ ParseError err

189+

190+-- | Parse a buffered source using a parser, returning the parsed value and the

191+-- remaining source.

192+--

193+-- /Internal/

194+{-# INLINE [3] parse #-}

195+parse

196+ :: MonadThrow m

197+ => ParserK.Parser m a b

198+ -> Producer m (Source s a) a

199+ -> Source s a

200+ -> m (b, Source s a)

201+parse = parseD . ParserK.fromParserK

202+

203+-------------------------------------------------------------------------------

204+-- Nested parsing

205+-------------------------------------------------------------------------------

206+

207+{-# INLINE parseManyD #-}

208+parseManyD :: MonadThrow m =>

209+ ParserD.Parser m a b

210+ -> Producer m (Source x a) a

211+ -> Producer m (Source x a) b

212+parseManyD parser reader = Producer step return return

213+

214+ where

215+

216+ {-# INLINE_LATE step #-}

217+ step src = do

218+ if isEmpty src

219+ then return Stop

220+ else do

221+ (b, s1) <- parseD parser reader src

222+ return $ Yield b s1

223+

224+-- | Apply a parser repeatedly on a buffered source producer to generate a

225+-- producer of parsed values.

226+--

227+-- /Internal/

228+{-# INLINE parseMany #-}

229+parseMany :: MonadThrow m =>

230+ ParserK.Parser m a b

231+ -> Producer m (Source x a) a

232+ -> Producer m (Source x a) b

233+parseMany parser = parseManyD (ParserK.fromParserK parser)

src/Streamly/Internal/Data/Producer/Type.hs+3−1

@@ -69,7 +69,9 @@ nil = nilM (\_ -> return ())

69{-# INLINE unfoldrM #-}

70unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> Producer m a b

71unfoldrM next = Producer step return return

72+

72− where

73+ where

74+

73 {-# INLINE_LATE step #-}

75 {-# INLINE_LATE step #-}

74 step st = do

76 step st = do

75 r <- next st

77 r <- next st

test/Streamly/Test/Data/Parser/ParserD.hs+1−1

@@ -627,7 +627,7 @@ parseUnfold = do

627 Source.producer

628 $ Producer.concat Producer.fromList A.producer

629 let streamParser =

630− Producer.simplify (Producer.parseManyD parser readSrc)

630+ Producer.simplify (Source.parseManyD parser readSrc)

631 xs <- run

632 $ S.toList

633 $ S.concatUnfold Unfold.fromList