cc8cd01 · streamly · git.iko.soy

git.iko.soy/streamly

Simplify the Parse type

* Return the unused count in Halt instead of in extract. * Use "Back 0" instead of "Hold" Performance seems equivalent with these changes.

commitcc8cd01bfe98e29f25259c6b81d9d06e56da2655 authorHarendra Kumar <harendra@composewell.com> dateSun 22 Mar 2020, 20:51 (7 years ago) parentdf63313

6 files changed+54−59

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+4−1 src/Streamly/Internal/Data/Fold.hs+2−3 src/Streamly/Internal/Data/Parse.hs+14−14 src/Streamly/Internal/Data/Parse/Types.hs+16−22 src/Streamly/Internal/Data/Stream/Prelude.hs+1−1 src/Streamly/Internal/Data/Stream/StreamD.hs+17−18

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

@@ -56,16 +56,20 @@ benchIOSink value name f =

5656-- Parsers

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

5858

59+{-# INLINE any #-}

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

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

6162

63+{-# INLINE all #-}

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

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

6466

67+{-# INLINE zipAllAny #-}

6568zipAllAny :: (Monad m, Ord a)

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

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

6871

72+{-# INLINE take #-}

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

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

7175

@@ -81,7 +85,6 @@ o_1_space_serial_parse value =

8185 , benchIOSink value "take" $ take value

8286 ]

8387

84−

8588-------------------------------------------------------------------------------

8689-- Driver

8790-------------------------------------------------------------------------------

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

@@ -854,10 +854,9 @@ take n (Fold fstep finitial fextract) = Parse step initial extract

854854 s1 = Tuple' i1 res

855855 if i1 < n

856856 then return $ Keep 0 s1

857− else return $ Halt s1

857+ else return $ Halt 0 s1

858858

859− extract (Tuple' _ r) = fmap f (fextract r)

860− where f x = Right (0, x)

859+ extract (Tuple' _ r) = fmap Right (fextract r)

861860

862861------------------------------------------------------------------------------

863862-- Binary APIs

src/Streamly/Internal/Data/Parse.hs+14−14

@@ -53,15 +53,15 @@ import Streamly.Internal.Data.Strict

5353--

5454{-# INLINABLE any #-}

5555any :: Monad m => (a -> Bool) -> Parse m a Bool

56−any predicate = Parse step initial (\x -> return $ Right (0,x))

56+any predicate = Parse step initial (return . Right)

5757 where

5858 initial = return False

5959 step s a = return $

6060 if s

61− then Halt True

61+ then Halt 0 True

6262 else

6363 if predicate a

64− then Halt True

64+ then Halt 0 True

6565 else Keep 0 False

6666

6767-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]

@@ -69,7 +69,7 @@ any predicate = Parse step initial (\x -> return $ Right (0,x))

6969--

7070{-# INLINABLE all #-}

7171all :: Monad m => (a -> Bool) -> Parse m a Bool

72−all predicate = Parse step initial (\x -> return $ Right (0,x))

72+all predicate = Parse step initial (return . Right)

7373 where

7474 initial = return True

7575 step s a = return $

@@ -77,8 +77,8 @@ all predicate = Parse step initial (\x -> return $ Right (0,x))

7777 then

7878 if predicate a

7979 then Keep 0 True

80− else Halt False

81− else Halt False

80+ else Halt 0 False

81+ else Halt 0 False

8282

8383-------------------------------------------------------------------------------

8484-- Taking elements

@@ -106,7 +106,7 @@ takeExact n (Fold fstep finitial fextract) = Parse step initial extract

106106 res <- fstep r a

107107 let i1 = i + 1

108108 s1 = Tuple' i1 res

109− return $ if i1 < n then Hold s1 else Halt s1

109+ return $ if i1 < n then Back 0 s1 else Halt 0 s1

110110

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

112112

@@ -118,7 +118,7 @@ takeExact n (Fold fstep finitial fextract) = Parse step initial extract

118118

119119 f x =

120120 if n == i

121− then Right (0, x)

121+ then Right x

122122 else Left err

123123

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

@@ -146,7 +146,7 @@ takeAtLeast n (Fold fstep finitial fextract) = Parse step initial extract

146146 res <- fstep r a

147147 let i1 = i + 1

148148 s1 = Tuple' i1 res

149− return $ Hold s1

149+ return $ Back 0 s1

150150

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

152152

@@ -158,7 +158,7 @@ takeAtLeast n (Fold fstep finitial fextract) = Parse step initial extract

158158

159159 f x =

160160 if i >= n

161− then Right (0, x)

161+ then Right x

162162 else Left err

163163

164164-- | Take until the predicate fails. Does not take the failing element.

@@ -182,10 +182,10 @@ takeWhile predicate (Fold fstep finitial fextract) =

182182 step s a = do

183183 if predicate a

184184 then Keep 0 <$> fstep s a

185− else return $ Halt s

185+ else return $ Halt 1 s

186186 extract s = do

187187 b <- fextract s

188− return $ Right (1, b)

188+ return $ Right b

189189

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

191191-- element.

@@ -212,10 +212,10 @@ endOn predicate (Fold fstep finitial fextract) =

212212 step s a = do

213213 if not (predicate a)

214214 then Keep 0 <$> fstep s a

215− else return $ Halt s

215+ else return $ Halt 0 s

216216 extract s = do

217217 b <- fextract s

218− return $ Right (0, b)

218+ return $ Right b

219219

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

221221-- element as well.

src/Streamly/Internal/Data/Parse/Types.hs+16−22

@@ -68,10 +68,7 @@ import Fusion.Plugin.Types (Fuse(..))

6868--

6969{-# ANN type Step Fuse #-}

7070data Step s =

71− Hold s -- ^ Hold the current input in the buffer, the input is

72− -- accepted tentatively, but the fold may later fail with the

73− -- input remaining unused.

74− | Keep Int s -- ^ Keep @n@ most recent inputs, including the input of this

71+ Keep Int s -- ^ Keep @n@ most recent inputs, including the input of this

7572 -- step invocation, and discard the rest. This indicates a

7673 -- commit of an intermediate result of the fold. A fold cannot

7774 -- fail beyond this commit point. If the fold terminates it

@@ -83,11 +80,10 @@ data Step s =

8380 -- inputs from the requested point in the buffer. Note that

8481 -- the driver cannot go back beyond the last commit point

8582 -- created by 'Keep'.

86− | Halt s -- ^ Halt because the result of the fold will not change after

87− -- this point. Once a fold halts, driving it further may

88− -- produce undefined behavior. An @extract@ after the 'Halt'

89− -- would return a count of unused elements which includes the

90− -- element on which 'Halt' occurred.

83+ | Halt Int s -- ^ Halt because the result of the fold will not change after

84+ -- this point. Returns a count of unused elements which

85+ -- includes the element on which 'Halt' occurred. Once a fold

86+ -- halts, driving it further may produce undefined behavior.

9187

9288-- Note: Instead of returning the unused count as part of extract, we can

9389-- return it via Halt command. However, some folds may not ever halt, but they

@@ -104,17 +100,17 @@ data Step s =

104100data Parse m a b =

105101 forall s. Parse (s -> a -> m (Step s))

106102 (m s)

107− (s -> m (Either String (Int, b)))

103+ (s -> m (Either String b))

108104

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

110106--

111107instance Monad m => Functor (Parse m a) where

112108 {-# INLINE fmap #-}

113− fmap f (Parse step initial extract) = Parse step initial (fmap4 f extract)

109+ fmap f (Parse step initial extract) = Parse step initial (fmap3 f extract)

114110

115111 where

116112

117− fmap4 g = fmap (fmap (fmap (fmap g)))

113+ fmap3 g = fmap (fmap (fmap g))

118114

119115 {-# INLINE (<$) #-}

120116 (<$) b = \_ -> pure b

@@ -130,9 +126,9 @@ data SeqParseState sl f sr =

130126--

131127instance Monad m => Applicative (Parse m a) where

132128 {-# INLINE pure #-}

133− pure b = Parse (\_ _ -> return $ Halt ())

129+ pure b = Parse (\_ _ -> return $ Halt 0 ())

134130 (return ())

135− (\_ -> return $ Right (0, b))

131+ (\_ -> return $ Right b)

136132

137133 {-# INLINE (<*>) #-}

138134 (Parse stepL initialL extractL) <*> (Parse stepR initialR extractR) =

@@ -148,26 +144,24 @@ instance Monad m => Applicative (Parse m a) where

148144 r <- stepL st a

149145 case r of

150146 Keep n s -> return $ Keep n (SeqParseL s)

151− Hold s -> return $ Hold (SeqParseL s)

152147 Back n s -> return $ Back n (SeqParseL s)

153− Halt s -> do

148+ Halt n s -> do

154149 res <- extractL s

155150 case res of

156− Left err -> return $ Halt (SeqParseLErr err)

157− Right (n, f) -> Back n <$> (SeqParseR f <$> initialR)

151+ Left err -> return $ Halt n (SeqParseLErr err)

152+ Right f -> Back n <$> (SeqParseR f <$> initialR)

158153

159154 step (SeqParseR f st) a = do

160155 r <- stepR st a

161156 return $ case r of

162157 Keep n s -> Keep n (SeqParseR f s)

163− Hold s -> Hold (SeqParseR f s)

164158 Back n s -> Back n (SeqParseR f s)

165− Halt s -> Halt (SeqParseR f s)

159+ Halt n s -> Halt n (SeqParseR f s)

166160

167− step s@(SeqParseLErr _) _ = return $ Halt s

161+ step (SeqParseLErr _) _ = error "step called in SeqParseLErr"

168162

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

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

164+ extract (SeqParseR f s) = fmap (fmap f) (extractR s)

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

172166 extract (SeqParseLErr err) =

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

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

@@ -164,7 +164,7 @@ parselMx'

164164 :: (IsStream t, Monad m)

165165 => (s -> a -> m (Step s))

166166 -> m s

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

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

168168 -> t m a

169169 -> m (Either String b)

170170parselMx' step initial extract m =

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

@@ -974,7 +974,7 @@ parselMx'

974974 :: Monad m

975975 => (s -> a -> m (PR.Step s))

976976 -> m s

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

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

978978 -> Stream m a

979979 -> m (Either String b)

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

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

996996 PR.Keep n pst1 -> do

997997 assert (n <= length (x:buf)) (return ())

998998 go SPEC s (Prelude.take n (x:buf)) pst1

999+ -- PR.Back 0 pst1 -> go SPEC s (x:buf) pst1

9991000 PR.Back n pst1 -> do

10001001 assert (n <= length (x:buf)) (return ())

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

10021003 src = Prelude.reverse src0

10031004 gobuf SPEC s buf1 src pst1

1004− PR.Hold pst1 -> go SPEC s (x:buf) pst1

1005− PR.Halt pst1 -> fmap (fmap snd) (extract pst1)

1005+ PR.Halt _ pst1 -> extract pst1

10061006 Skip s -> go SPEC s buf pst

1007− Stop -> fmap (fmap snd) (extract pst)

1007+ Stop -> extract pst

10081008

10091009 gobuf !_ s buf [] !pst = go SPEC s buf pst

10101010 gobuf !_ s buf (x:xs) !pst = do

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

10141014 PR.Keep n pst1 -> do

10151015 assert (n <= length (x:buf)) (return ())

10161016 gobuf SPEC s (Prelude.take n (x:buf)) xs pst1

1017+ -- PR.Back 0 pst1 -> gobuf SPEC s (x:buf) xs pst1

10171018 PR.Back n pst1 -> do

10181019 assert (n <= length (x:buf)) (return ())

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

10201021 src = Prelude.reverse src0 ++ xs

10211022 gobuf SPEC s buf1 src pst1

1022− PR.Hold pst1 -> gobuf SPEC s (x:buf) xs pst1

1023− PR.Halt pst1 -> fmap (fmap snd) (extract pst1)

1023+ PR.Halt _ pst1 -> extract pst1

10241024

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

10261026-- Repeated parsing

@@ -1069,19 +1069,19 @@ parseChunks (Parse pstep initial extract) (Stream step state) =

10691069 assert (n <= length (x:buf)) (return ())

10701070 let buf1 = Prelude.take n (x:buf)

10711071 return $ Skip $ ParseChunksStream s buf1 pst1

1072+ -- PR.Back 0 pst1 ->

1073+ -- return $ Skip $ ParseChunksStream s (x:buf) pst1

10721074 PR.Back n pst1 -> do

10731075 assert (n <= length (x:buf)) (return ())

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

10751077 src = Prelude.reverse src0

10761078 return $ Skip $ ParseChunksBuf src s buf1 pst1

1077− PR.Hold pst1 ->

1078− return $ Skip $ ParseChunksStream s (x:buf) pst1

1079− PR.Halt pst1 -> do

1079+ -- XXX Halt 0 common case?

1080+ PR.Halt n pst1 -> do

10801081 res <- extract pst1

10811082 case res of

10821083 Left err -> error err

1083− -- XXX (0,a) common case

1084− Right (n, a) -> do

1084+ Right a -> do

10851085 assert (n <= length (x:buf)) (return ())

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

10871087 return $ Skip $ ParseChunksYield a (ParseChunksInit src s)

@@ -1090,8 +1090,8 @@ parseChunks (Parse pstep initial extract) (Stream step state) =

10901090 res <- extract pst

10911091 case res of

10921092 Left err -> error err

1093− Right (n, a) -> do

1094− let src = Prelude.reverse (Prelude.take n (buf))

1093+ Right a -> do

1094+ let src = Prelude.reverse buf

10951095 return $ Skip $ ParseChunksYield a (ParseChunksInitLeftOver src)

10961096

10971097 -- go back to stream processing mode

@@ -1107,19 +1107,18 @@ parseChunks (Parse pstep initial extract) (Stream step state) =

11071107 assert (n <= length (x:buf)) (return ())

11081108 let buf1 = Prelude.take n (x:buf)

11091109 return $ Skip $ ParseChunksBuf xs s buf1 pst1

1110+ -- PR.Back 0 pst1 -> return $ Skip $ ParseChunksBuf xs s (x:buf) pst1

11101111 PR.Back n pst1 -> do

11111112 assert (n <= length (x:buf)) (return ())

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

11131114 src = Prelude.reverse src0 ++ xs

11141115 return $ Skip $ ParseChunksBuf src s buf1 pst1

1115− PR.Hold pst1 ->

1116− return $ Skip $ ParseChunksBuf xs s (x:buf) pst1

1117− PR.Halt pst1 -> do

1116+ -- XXX have 0 case

1117+ PR.Halt n pst1 -> do

11181118 res <- extract pst1

11191119 case res of

11201120 Left err -> error err

1121− -- XXX have (0,a) case

1122− Right (n, a) -> do

1121+ Right a -> do

11231122 assert (n <= length (x:buf)) (return ())

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

11251124 return $ Skip $ ParseChunksYield a (ParseChunksInit src s)