f6327e5 · streamly · git.iko.soy

git.iko.soy/streamly

Use exceptions instead of Either return in extract

Also instead of returning wrapped state in "Stop" return type, return the final extracted value. a) This makes a lot of code simpler because extract and error handling is not required at Stop. b) Not returning internal state indicates that the parse has ended and state is not supposed to be used from this point onwards. c) It may add a little complexity in the parser code as the parser has to extract the value from state at Stop. d) However, extract is still needed. But it is only needed if the fold remains partial when the stream stops. In such case we may have to use exception handling to detect error, and to distinguish the parse errors from any other types of errors. But since this is not common case it does not come in the fast path. Note that we could remove extract altogether but that means we will have to store the intermediate fold values in the driver loop which impacts performance.

commitf6327e5b31e91d33139f93ccdf56f387ed047a85 authorHarendra Kumar <harendra@composewell.com> dateThu 9 Apr 2020, 18:31 (7 years ago) parent3d88108

7 files changed+113−122

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+9−9 src/Streamly/Internal/Data/Fold.hs+2−2 src/Streamly/Internal/Data/Parser.hs+41−44 src/Streamly/Internal/Data/Parser/Types.hs+39−36 src/Streamly/Internal/Data/Stream/Prelude.hs+3−3 src/Streamly/Internal/Data/Stream/StreamD.hs+18−27 src/Streamly/Internal/Prelude.hs+1−1

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

@@ -57,22 +57,22 @@ benchIOSink value name f =

5757-------------------------------------------------------------------------------

5858

5959{-# INLINE any #-}

60−any :: (Monad m, Ord a) => a -> SerialT m a -> m (Either String Bool)

60+any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool

6161any value = IP.parse (PR.any (> value))

6262

6363{-# INLINE all #-}

64−all :: (Monad m, Ord a) => a -> SerialT m a -> m (Either String Bool)

64+all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool

6565all value = IP.parse (PR.all (<= value))

6666

67−{-# INLINE zipAllAny #-}

68−zipAllAny :: (Monad m, Ord a)

69− => a -> SerialT m a -> m (Either String (Bool, Bool))

70−zipAllAny value = IP.parse ((,) <$> PR.all (<= value) <*> PR.any (> value))

71−

7267{-# INLINE take #-}

73−take :: Monad m => Int -> SerialT m a -> m (Either String ())

68+take :: Monad m => Int -> SerialT m a -> m ()

7469take value = IP.parse (FL.take value FL.drain)

7570

71+{-# INLINE splitAllAny #-}

72+splitAllAny :: (Monad m, Ord a)

73+ => a -> SerialT m a -> m (Bool, Bool)

74+splitAllAny value = IP.parse ((,) <$> PR.all (<= value) <*> PR.any (> value))

75+

7676-------------------------------------------------------------------------------

7777-- Benchmarks

7878-------------------------------------------------------------------------------

@@ -81,8 +81,8 @@ o_1_space_serial_parse :: Int -> [Benchmark]

8181o_1_space_serial_parse value =

8282 [ benchIOSink value "any" $ any value

8383 , benchIOSink value "all" $ all value

84− , benchIOSink value "(all,any)" $ zipAllAny value

8584 , benchIOSink value "take" $ take value

85+ , benchIOSink value "split (all,any)" $ splitAllAny value

8686 ]

8787

8888-------------------------------------------------------------------------------

src/Streamly/Internal/Data/Fold.hs+2−2

@@ -856,9 +856,9 @@ take n (Fold fstep finitial fextract) = Parser step initial extract

856856 s1 = Tuple' i1 res

857857 if i1 < n

858858 then return $ Yield 0 s1

859− else return $ Stop 0 s1

859+ else Stop 0 <$> fextract res

860860

861− extract (Tuple' _ r) = fmap Right (fextract r)

861+ extract (Tuple' _ r) = fextract r

862862

863863------------------------------------------------------------------------------

864864-- Binary APIs

src/Streamly/Internal/Data/Parser.hs+41−44

@@ -1,7 +1,5 @@

1−{-# LANGUAGE BangPatterns #-}

21{-# LANGUAGE CPP #-}

32{-# LANGUAGE RankNTypes #-}

4−{-# LANGUAGE RecordWildCards #-}

53{-# LANGUAGE ScopedTypeVariables #-}

75-- |

@@ -44,8 +42,8 @@ where

4442import Prelude

4543 hiding (any, all, takeWhile)

4644

47−import Streamly.Internal.Data.Parser.Types (Parser(..), Step(..))

4845import Streamly.Internal.Data.Fold.Types (Fold(..))

46+import Streamly.Internal.Data.Parser.Types (Parser(..), Step(..))

4947

5048import Streamly.Internal.Data.Strict

5149

@@ -57,17 +55,14 @@ import Streamly.Internal.Data.Strict

5755--

5856{-# INLINE fromFold #-}

5957fromFold :: Monad m => Fold m a b -> Parser m a b

60−fromFold (Fold fstep finitial fextract) = Parser step initial extract

58+fromFold (Fold fstep finitial fextract) = Parser step finitial fextract

59+

6160 where

6261

63− initial = finitial

6462 step s a = Yield 0 <$> fstep s a

65− extract s = do

66− r <- fextract s

67− return $ Right r

6863

6964-------------------------------------------------------------------------------

70−-- Terminating folds

65+-- Terminating but not failing folds

7166-------------------------------------------------------------------------------

7267--

7368-- |

@@ -76,9 +71,12 @@ fromFold (Fold fstep finitial fextract) = Parser step initial extract

7671--

7772{-# INLINABLE any #-}

7873any :: Monad m => (a -> Bool) -> Parser m a Bool

79−any predicate = Parser step initial (return . Right)

74+any predicate = Parser step initial return

75+

8076 where

77+

8178 initial = return False

79+

8280 step s a = return $

8381 if s

8482 then Stop 0 True

@@ -93,9 +91,12 @@ any predicate = Parser step initial (return . Right)

9391--

9492{-# INLINABLE all #-}

9593all :: Monad m => (a -> Bool) -> Parser m a Bool

96−all predicate = Parser step initial (return . Right)

94+all predicate = Parser step initial return

95+

9796 where

97+

9898 initial = return True

99+

99100 step s a = return $

100101 if s

101102 then

@@ -108,6 +109,8 @@ all predicate = Parser step initial (return . Right)

108109-- Taking elements

109110-------------------------------------------------------------------------------

110111--

112+-- XXX can we use a "cmp" operation in a common implementation?

113+--

111114-- | Stops after taking exactly @n@ input elements.

112115--

113116-- * Stops - after @n@ elements.

@@ -118,21 +121,24 @@ all predicate = Parser step initial (return . Right)

118121--

119122-- /Internal/

120123--

121−{-# INLINABLE takeEQ #-}

124+{-# INLINE takeEQ #-}

122125takeEQ :: Monad m => Int -> Fold m a b -> Parser m a b

123126takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

124127

125128 where

126129

127− initial = (Tuple' 0) <$> finitial

130+ initial = Tuple' 0 <$> finitial

128131

129132 step (Tuple' i r) a = do

130133 res <- fstep r a

131134 let i1 = i + 1

132135 s1 = Tuple' i1 res

133− return $ if i1 < n then Skip 0 s1 else Stop 0 s1

136+ if i1 < n then return (Skip 0 s1) else Stop 0 <$> fextract res

134137

135− extract (Tuple' i r) = fmap f (fextract r)

138+ extract (Tuple' i r) =

139+ if n == i

140+ then fextract r

141+ else error err

136142

137143 where

138144

@@ -140,11 +146,6 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

140146 "takeEQ: Expecting exactly " ++ show n

141147 ++ " elements, got " ++ show i

142148

143− f x =

144− if n == i

145− then Right x

146− else Left err

147−

148149-- | Take at least @n@ input elements, but can collect more.

149150--

150151-- * Stops - never.

@@ -158,21 +159,22 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

158159--

159160-- /Internal/

160161--

161−{-# INLINABLE takeGE #-}

162+{-# INLINE takeGE #-}

162163takeGE :: Monad m => Int -> Fold m a b -> Parser m a b

163164takeGE n (Fold fstep finitial fextract) = Parser step initial extract

164165

165166 where

166167

167− initial = (Tuple' 0) <$> finitial

168+ initial = Tuple' 0 <$> finitial

168169

169170 step (Tuple' i r) a = do

170171 res <- fstep r a

171172 let i1 = i + 1

172173 s1 = Tuple' i1 res

173− if i1 < n

174− then return $ Skip 0 s1

175− else return $ Yield 0 s1

174+ return $

175+ if i1 < n

176+ then Skip 0 s1

177+ else Yield 0 s1

176178

177179 extract (Tuple' i r) = fmap f (fextract r)

178180

@@ -184,8 +186,8 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract

184186

185187 f x =

186188 if i >= n

187− then Right x

188− else Left err

189+ then x

190+ else error err

189191

190192-- | Take until the predicate fails. The element on which the predicate fails

191193-- is returned back to the input stream.

@@ -202,21 +204,19 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract

202204--

203205-- /Internal/

204206--

205−{-# INLINABLE takeWhile #-}

207+{-# INLINE takeWhile #-}

206208takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b

207209takeWhile predicate (Fold fstep finitial fextract) =

208− Parser step initial extract

210+ Parser step initial fextract

209211

210212 where

211213

212214 initial = finitial

213− step s a = do

215+

216+ step s a =

214217 if predicate a

215218 then Yield 0 <$> fstep s a

216− else return $ Stop 1 s

217− extract s = do

218− b <- fextract s

219− return $ Right b

219+ else Stop 1 <$> fextract s

220220

221221-- | Keep taking elements until the predicate succeeds. Drop the succeeding

222222-- element.

@@ -237,18 +237,15 @@ takeWhile predicate (Fold fstep finitial fextract) =

237237{-# INLINABLE sepBy #-}

238238sepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b

239239sepBy predicate (Fold fstep finitial fextract) =

240− Parser step initial extract

240+ Parser step initial fextract

241241

242242 where

243243

244244 initial = finitial

245− step s a = do

245+ step s a =

246246 if not (predicate a)

247247 then Yield 0 <$> fstep s a

248− else return $ Stop 0 s

249− extract s = do

250− b <- fextract s

251− return $ Right b

248+ else Stop 0 <$> fextract s

252249

253250-- | Keep taking elements until the predicate succeeds. Take the succeeding

254251-- element as well.

@@ -303,10 +300,10 @@ sepByMax predicate count (Fold fstep finitial fextract) =

303300 s1 = Tuple' i1 res

304301 if not (predicate a) && i1 < count

305302 then return $ Yield 0 s1

306− else return $ Stop 0 s1

307− extract (Tuple' _ r) = do

308− b <- fextract r

309− return $ Right b

303+ else do

304+ b <- fextract res

305+ return $ Stop 0 b

306+ extract (Tuple' _ r) = fextract r

310307

311308-- | Like 'splitOn' after stripping leading, trailing, and repeated separators.

312309-- Therefore, @".a..b."@ with '.' as the separator would be parsed as

src/Streamly/Internal/Data/Parser/Types.hs+39−36

@@ -1,8 +1,4 @@

11{-# LANGUAGE ExistentialQuantification #-}

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE DeriveFunctor #-}

4−{-# LANGUAGE DeriveAnyClass #-}

5−{-# LANGUAGE DeriveGeneric #-}

73-- |

84-- Module : Streamly.Parser.Types

@@ -70,7 +66,7 @@ import Fusion.Plugin.Types (Fuse(..))

7066-- /Internal/

7167--

7268{-# ANN type Step Fuse #-}

73−data Step s =

69+data Step s b =

7470 Yield Int s

7571 -- ^ @Yield offset state@ indicates that the parser has yielded a new

7672 -- result which is a point of no return. The result can be extracted

@@ -87,13 +83,19 @@ data Step s =

8783 -- the next input to the parser. The offset cannot be beyond the latest

8884 -- point of no return created by @Yield@.

8985

90− | Stop Int s

86+ | Stop Int b

9187 -- ^ @Stop offset state@ asks the driver to stop driving the parser because

9288 -- it has reached a fixed point and further input will not change the

9389 -- result. @offset@ is the count of unused elements which includes the

9490 -- element on which 'Stop' occurred. Once a fold stops, driving it further

9591 -- may produce undefined behavior.

9692

93+instance Functor (Step s) where

94+ {-# INLINE fmap #-}

95+ fmap _ (Yield n s) = Yield n s

96+ fmap _ (Skip n s) = Skip n s

97+ fmap f (Stop n b) = Stop n (f b)

98+

9799-- | A parsing fold is represented as @Parser step initial extract@. Before we

98100-- drive a parser we call the @initial@ action to retrieve the initial state of

99101-- the fold. The driver invokes @step@ with the state returned by the previous

@@ -103,39 +105,43 @@ data Step s =

103105-- error or an output value.

104106--

105107data Parser m a b =

106− forall s. Parser (s -> a -> m (Step s)) (m s) (s -> m (Either String b))

108+ forall s. Parser (s -> a -> m (Step s b)) (m s) (s -> m b)

107109

108110-- | Maps a function over the output of the fold.

109111--

110112instance Functor m => Functor (Parser m a) where

111113 {-# INLINE fmap #-}

112− fmap f (Parser step initial extract) =

113− Parser step initial (fmap3 f extract)

114+ fmap f (Parser step1 initial extract) =

115+ Parser step initial (fmap2 f extract)

114116

115117 where

116118

117− fmap3 g = fmap (fmap (fmap g))

119+ step s b = fmap2 f (step1 s b)

120+ fmap2 g = fmap (fmap g)

118121

119122{-# INLINE wrap #-}

120123wrap :: Monad m => b -> Parser m a b

121−wrap b = Parser (\_ _ -> pure $ Stop 0 ()) -- step

122− (pure ()) -- initial

123− (\_ -> pure $ Right b) -- extract

124+wrap b = Parser (\_ _ -> pure $ Stop 0 b) -- step

125+ (pure ()) -- initial

126+ (\_ -> pure b) -- extract

124127

125−{-# ANN type SeqParseState Fuse #-}

126−data SeqParseState sl f sr =

127− SeqParseL sl | SeqParseR f sr | SeqParseLErr String

128+-------------------------------------------------------------------------------

129+-- Sequential applicative

130+-------------------------------------------------------------------------------

128131

129−-- XXX implement interleaved variant, parse using the first parser and then

130−-- using the second parser alternately.

132+{-# ANN type SeqParseState Fuse #-}

133+data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr

131134

132−-- | Apply two parsers sequentially to an input stream. The input is provided

133−-- to the first parser, when it is done the remaining input is provided to the

134−-- second parser. If both the parsers succeed there outputs are combined using

135−-- the supplied function. The operation fails if any of the parsers fail.

135+-- | Sequential application. Apply two parsers sequentially to an input stream.

136+-- The input is provided to the first parser, when it is done the remaining

137+-- input is provided to the second parser. If both the parsers succeed their

138+-- outputs are combined using the supplied function. The operation fails if any

139+-- of the parsers fail.

136140--

137141-- This undoes an "append" of two streams, it splits the streams.

138142--

143+-- /Internal/

144+--

139145{-# INLINE splitWith #-}

140146splitWith :: Monad m

141147 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

@@ -152,28 +158,25 @@ splitWith func (Parser stepL initialL extractL)

152158 step (SeqParseL st) a = do

153159 r <- stepL st a

154160 case r of

161+ -- Note: this leads to buffering even if we are not in an

162+ -- Alternative composition.

155163 Yield _ s -> return $ Skip 0 (SeqParseL s)

156164 Skip n s -> return $ Skip n (SeqParseL s)

157− Stop n s -> do

158− res <- extractL s

159− case res of

160− Left err -> return $ Stop n (SeqParseLErr err)

161− Right x -> Skip n <$> (SeqParseR (func x) <$> initialR)

165+ Stop n b -> Skip n <$> (SeqParseR (func b) <$> initialR)

162166

163167 step (SeqParseR f st) a = do

164168 r <- stepR st a

165169 return $ case r of

166170 Yield n s -> Yield n (SeqParseR f s)

167171 Skip n s -> Skip n (SeqParseR f s)

168− Stop n s -> Stop n (SeqParseR f s)

169−

170− step (SeqParseLErr _) _ = error "step called in SeqParseLErr"

171−

172− -- XXX bimap to add "<*>: Right parse failed" to the error message

173− extract (SeqParseR f s) = fmap (fmap f) (extractR s)

174− extract (SeqParseL _) = return $ Left "<*>: Incomplete left parse"

175− extract (SeqParseLErr err) =

176− return $ Left $ "<*>: Left parse failed\n" ++ err

172+ Stop n b -> Stop n (f b)

173+

174+ extract (SeqParseR f sR) = fmap f (extractR sR)

175+ extract (SeqParseL sL) = do

176+ rL <- extractL sL

177+ sR <- initialR

178+ rR <- extractR sR

179+ return $ func rL rR

177180

178181-- | 'Applicative' form of 'splitWith'.

179182instance Monad m => Applicative (Parser m a) where

src/Streamly/Internal/Data/Stream/Prelude.hs+3−3

@@ -162,11 +162,11 @@ foldlMx' step begin done m = S.foldlMx' step begin done $ toStreamS m

162162{-# INLINE parselMx' #-}

163163parselMx'

164164 :: (IsStream t, Monad m)

165− => (s -> a -> m (Step s))

165+ => (s -> a -> m (Step s b))

166166 -> m s

167− -> (s -> m (Either String b))

167+ -> (s -> m b)

168168 -> t m a

169− -> m (Either String b)

169+ -> m b

170170parselMx' step initial extract m =

171171 D.parselMx' step initial extract $ D.toStreamD m

172172

src/Streamly/Internal/Data/Stream/StreamD.hs+18−27

@@ -972,11 +972,11 @@ splitAt n ls

972972{-# INLINE_NORMAL parselMx' #-}

973973parselMx'

974974 :: Monad m

975− => (s -> a -> m (PR.Step s))

975+ => (s -> a -> m (PR.Step s b))

976976 -> m s

977− -> (s -> m (Either String b))

977+ -> (s -> m b)

978978 -> Stream m a

979− -> m (Either String b)

979+ -> m b

980980parselMx' pstep initial extract (Stream step state) = do

981981 initial >>= go SPEC state []

982982

@@ -1002,7 +1002,7 @@ parselMx' pstep initial extract (Stream step state) = do

10021002 let (src0, buf1) = splitAt n (x:buf)

10031003 src = Prelude.reverse src0

10041004 gobuf SPEC s buf1 src pst1

1005− PR.Stop _ pst1 -> extract pst1

1005+ PR.Stop _ b -> return b

10061006 Skip s -> go SPEC s buf pst

10071007 Stop -> extract pst

10081008

@@ -1020,7 +1020,7 @@ parselMx' pstep initial extract (Stream step state) = do

10201020 let (src0, buf1) = splitAt n (x:buf)

10211021 src = Prelude.reverse src0 ++ xs

10221022 gobuf SPEC s buf1 src pst1

1023− PR.Stop _ pst1 -> extract pst1

1023+ PR.Stop _ b -> return b

10241024

10251025------------------------------------------------------------------------------

10261026-- Repeated parsing

@@ -1077,22 +1077,17 @@ splitParse (Parser pstep initial extract) (Stream step state) =

10771077 src = Prelude.reverse src0

10781078 return $ Skip $ ParseChunksBuf src s buf1 pst1

10791079 -- XXX Halt 0 common case?

1080− PR.Stop n pst1 -> do

1081− res <- extract pst1

1082− case res of

1083− Left err -> error err

1084− Right a -> do

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

1086− let src = Prelude.reverse (Prelude.take n (x:buf))

1087− return $ Skip $ ParseChunksYield a (ParseChunksInit src s)

1080+ PR.Stop n b -> do

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

1082+ let src = Prelude.reverse (Prelude.take n (x:buf))

1083+ return $ Skip $

1084+ ParseChunksYield b (ParseChunksInit src s)

10881085 Skip s -> return $ Skip $ ParseChunksStream s buf pst

10891086 Stop -> do

1090− res <- extract pst

1091− case res of

1092− Left err -> error err

1093− Right a -> do

1094− let src = Prelude.reverse buf

1095− return $ Skip $ ParseChunksYield a (ParseChunksInitLeftOver src)

1087+ b <- extract pst

1088+ let src = Prelude.reverse buf

1089+ return $ Skip $

1090+ ParseChunksYield b (ParseChunksInitLeftOver src)

10961091

10971092 -- go back to stream processing mode

10981093 stepOuter _ (ParseChunksBuf [] s buf pst) =

@@ -1114,14 +1109,10 @@ splitParse (Parser pstep initial extract) (Stream step state) =

11141109 src = Prelude.reverse src0 ++ xs

11151110 return $ Skip $ ParseChunksBuf src s buf1 pst1

11161111 -- XXX have 0 case

1117− PR.Stop n pst1 -> do

1118− res <- extract pst1

1119− case res of

1120− Left err -> error err

1121− Right a -> do

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

1123− let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1124− return $ Skip $ ParseChunksYield a (ParseChunksInit src s)

1112+ PR.Stop n b -> do

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

1114+ let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1115+ return $ Skip $ ParseChunksYield b (ParseChunksInit src s)

11251116

11261117 stepOuter _ (ParseChunksYield a next) = return $ Yield a next

11271118

src/Streamly/Internal/Prelude.hs+1−1

@@ -1202,7 +1202,7 @@ runSink = fold . toFold

12021202-- /Internal/

12031203--

12041204{-# INLINE parse #-}

1205−parse :: Monad m => Parser m a b -> SerialT m a -> m (Either String b)

1205+parse :: Monad m => Parser m a b -> SerialT m a -> m b

12061206parse (Parser step initial extract) = P.parselMx' step initial extract

12071207

12081208------------------------------------------------------------------------------