git.iko.soy/streamly
on master help sign in
INLINE some/many implement *>/<*

Benchmarks that improved: ParserK(cpuTime) Benchmark default(0)(μs) default(1) - default(0)(%) --------------------------- -------------- -------------------------- o-n-heap/parserK/sequenceA_ 11183.17 -32.75 o-n-heap/parserK/manyAlt 41514.00 -40.82 o-n-heap/parserK/someAlt 68026.25 -61.77

commitd7866f732d8fbbad827da18ba2c7d9adf946ffef authorHarendra Kumar <harendra@composewell.com> dateFri 24 Apr 2020, 02:59 (6 years ago) parentdde9041
3 files changed+64−10
compare with master
unifiedsplit
benchmark/Streamly/Benchmark/Data/ParserD.hs+20−7 benchmark/Streamly/Benchmark/Data/ParserK.hs+9 src/Streamly/Internal/Data/Parser/ParserK/Types.hs+35−3
benchmark/Streamly/Benchmark/Data/ParserD.hs+20−7
@@ -186,24 +186,31 @@ o_1_space_serial_parse value =
186186 , benchIOSink value "split (all,any)" $ splitAllAny value
187187 , benchIOSink value "many" many
188188 , benchIOSink value "some" some
189− , benchIOSink value "choice/100" $ choice (value `div` 100)
190189 , benchIOSink value "tee (all,any)" $ teeAllAny value
191190 , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
192191 , benchIOSink value "shortest (all,any)" $ shortestAllAny value
193192 , benchIOSink value "longest (all,any)" $ longestAllAny value
194− , benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
195− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
196− , benchIOSink value "sequence/100" $ sequence (value `div` 100)
197193 ]
198194
199−o_1_heap_serial_parse :: Int -> [Benchmark]
200−o_1_heap_serial_parse value =
195+-- These show non-linear time complexity
196+-- Increase in rss is 20-40% on doubling the stream size
197+o_n_heap_serial_parse :: Int -> [Benchmark]
198+o_n_heap_serial_parse value =
201199 [ benchIOSink value "lookAhead" $ lookAhead value
202200 , benchIOSink value "manyAlt" manyAlt
203201 , benchIOSink value "someAlt" someAlt
204202 , benchIOSink value "manyTill" $ manyTill value
205203 ]
206204
205+-- accumulate results in a list in IO
206+o_n_space_serial_parse :: Int -> [Benchmark]
207+o_n_space_serial_parse value =
208+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
209+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
210+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)
211+ , benchIOSink value "choice/100" $ choice (value `div` 100)
212+ ]
213+
207214-------------------------------------------------------------------------------
208215-- Driver
209216-------------------------------------------------------------------------------
@@ -225,7 +232,13 @@ main = do
225232 , bgroup "o-n-heap"
226233 [ bgroup "parser" $ concat
227234 [
228− o_1_heap_serial_parse value
235+ o_n_heap_serial_parse value
236+ ]
237+ ]
238+ , bgroup "o-n-space"
239+ [ bgroup "parser" $ concat
240+ [
241+ o_n_space_serial_parse value
229242 ]
230243 ]
231244 ]
benchmark/Streamly/Benchmark/Data/ParserK.hs+9
@@ -19,6 +19,7 @@ import System.Random (randomRIO)
1919import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
2020
2121import qualified Control.Applicative as AP
22+import qualified Data.Foldable as F
2223import qualified Data.Traversable as TR
2324import qualified Streamly as S hiding (runStream)
2425import qualified Streamly.Prelude as S
@@ -83,6 +84,13 @@ sequenceA value xs = do
8384 x <- IP.parseK (TR.sequenceA list) xs
8485 return $ Prelude.length x
8586
87+{-# INLINE sequenceA_ #-}
88+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
89+sequenceA_ value xs = do
90+ let parser = satisfy (> 0)
91+ list = Prelude.replicate value parser
92+ IP.parseK (F.sequenceA_ list) xs
93+
8694{-# INLINE sequence #-}
8795sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
8896sequence value xs = do
@@ -123,6 +131,7 @@ o_1_space_serial_parse value =
123131o_n_heap_serial_parse :: Int -> [Benchmark]
124132o_n_heap_serial_parse value =
125133 [ benchIOSink value "sequenceA" $ sequenceA value
134+ , benchIOSink value "sequenceA_" $ sequenceA_ value
126135 , benchIOSink value "sequence" $ sequence value
127136 , benchIOSink value "manyAlt" manyAlt
128137 , benchIOSink value "someAlt" someAlt
src/Streamly/Internal/Data/Parser/ParserK/Types.hs+35−3
@@ -58,7 +58,7 @@ yield b = MkParser (\_ yieldk -> yieldk (Z.nil, Right b))
5858-------------------------------------------------------------------------------
5959-- Sequential applicative
6060-------------------------------------------------------------------------------
61−--
61+
6262-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that
6363-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'
6464-- when fusion is important.
@@ -70,6 +70,20 @@ instance Monad m => Applicative (Parser m a) where
7070 {-# INLINE (<*>) #-}
7171 (<*>) = ap
7272
73+ {-# INLINE (*>) #-}
74+ m1 *> m2 = MkParser $ \inp yieldk ->
75+ let yield1 (z, b) = case b of
76+ Right _ -> runParser m2 z yieldk
77+ Left err -> runParser (die err) z yieldk
78+ in runParser m1 inp yield1
79+
80+ {-# INLINE (<*) #-}
81+ m1 <* m2 = MkParser $ \inp yieldk ->
82+ let yield1 (z, b) = case b of
83+ Right _ -> runParser m2 z (\(z1, _) -> yieldk (z1, b))
84+ Left err -> runParser (die err) z yieldk
85+ in runParser m1 inp yield1
86+
7387-- | See 'Streamly.Internal.Data.Parser.die'.
7488--
7589-- /Internal/
@@ -116,7 +130,7 @@ die err = MkParser (\z yieldk -> yieldk (z, Left err))
116130-- Alpha x -> [x,x2]
117131-- @
118132--
119−-- Seel also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance
133+-- See also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance
120134-- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need
121135-- fusion.
122136--
@@ -154,7 +168,25 @@ instance Monad m => Alternative (Parser m a) where
154168 Right _ -> yieldk (Z.release z, b)
155169 Left _ -> runParser m2 (Z.restore z) yieldk
156170 in runParser m1 (Z.checkpoint inp) yield1
157− -- XXX INLINE some and many?
171+
172+ -- some and many are implemented here instead of using default definitions
173+ -- so that we can use INLINE on them. It gives 50% performance improvement.
174+
175+ {-# INLINE many #-}
176+ many v = many_v
177+
178+ where
179+
180+ many_v = some_v <|> pure []
181+ some_v = (:) <$> v <*> many_v
182+
183+ {-# INLINE some #-}
184+ some v = some_v
185+
186+ where
187+
188+ many_v = some_v <|> pure []
189+ some_v = (:) <$> v <*> many_v
158190
159191-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as
160192-- '<|>', it selects the first succeeding parser.