on master help sign in
Add benchmarking for fromParserK
commitf0398ee8b6da0241c9e3b1dae68bf324aa3eefc0 authorHarendra Kumar <harendra@composewell.com> dateWed 15 Jul 2020, 17:40 (6 years ago) parent37f325e
2 files changed+35−11
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+19−11 benchmark/streamly-benchmarks.cabal+16
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+19−11
@@ -5,7 +5,9 @@
55-- License : BSD-3-Clause
66-- Maintainer : streamly@composewell.com
77
8+{-# LANGUAGE CPP #-}
89{-# LANGUAGE FlexibleContexts #-}
10+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
911
1012module Main
1113 (
@@ -59,6 +61,12 @@ benchIOSink value name f =
5961-- Parsers
6062-------------------------------------------------------------------------------
6163
64+#ifdef FROM_PARSERK
65+#define PARSE_OP (IP.parseD . PRD.fromParserK)
66+#else
67+#define PARSE_OP IP.parseK
68+#endif
69+
6270{-# INLINE satisfy #-}
6371satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
6472satisfy = PRD.toParserK . PRD.satisfy
@@ -69,7 +77,7 @@ any = PRD.toParserK . PRD.any
6977
7078{-# INLINE anyK #-}
7179anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
72−anyK value = IP.parseK (any (> value))
80+anyK value = PARSE_OP (any (> value))
7381
7482{-# INLINE all #-}
7583all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
@@ -77,7 +85,7 @@ all = PRD.toParserK . PRD.all
7785
7886{-# INLINE allK #-}
7987allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
80−allK value = IP.parseK (all (<= value))
88+allK value = PARSE_OP (all (<= value))
8189
8290{-# INLINE take #-}
8391take :: MonadCatch m => Int -> PR.Parser m a ()
@@ -85,7 +93,7 @@ take value = PRD.toParserK $ PRD.take value FL.drain
8593
8694{-# INLINE takeK #-}
8795takeK :: MonadCatch m => Int -> SerialT m a -> m ()
88−takeK value = IP.parseK (take value)
96+takeK value = PARSE_OP (take value)
8997
9098{-# INLINE takeWhile #-}
9199takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
@@ -93,20 +101,20 @@ takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain
93101
94102{-# INLINE takeWhileK #-}
95103takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
96−takeWhileK value = IP.parseK (takeWhile (<= value))
104+takeWhileK value = PARSE_OP (takeWhile (<= value))
97105
98106{-# INLINE splitApp #-}
99107splitApp :: MonadCatch m
100108 => Int -> SerialT m Int -> m (Bool, Bool)
101109splitApp value =
102− IP.parseK ((,) <$> any (>= (value `div` 2)) <*> any (> value))
110+ PARSE_OP ((,) <$> any (>= (value `div` 2)) <*> any (> value))
103111
104112{-# INLINE sequenceA #-}
105113sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
106114sequenceA value xs = do
107115 let parser = satisfy (> 0)
108116 list = Prelude.replicate value parser
109− x <- IP.parseK (TR.sequenceA list) xs
117+ x <- PARSE_OP (TR.sequenceA list) xs
110118 return $ Prelude.length x
111119
112120{-# INLINE sequenceA_ #-}
@@ -114,32 +122,32 @@ sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
114122sequenceA_ value xs = do
115123 let parser = satisfy (> 0)
116124 list = Prelude.replicate value parser
117− IP.parseK (F.sequenceA_ list) xs
125+ PARSE_OP (F.sequenceA_ list) xs
118126
119127{-# INLINE sequence #-}
120128sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
121129sequence value xs = do
122130 let parser = satisfy (> 0)
123131 list = Prelude.replicate value parser
124− x <- IP.parseK (TR.sequence list) xs
132+ x <- PARSE_OP (TR.sequence list) xs
125133 return $ Prelude.length x
126134
127135{-# INLINE manyAlt #-}
128136manyAlt :: MonadCatch m => SerialT m Int -> m Int
129137manyAlt xs = do
130− x <- IP.parseK (AP.many (satisfy (> 0))) xs
138+ x <- PARSE_OP (AP.many (satisfy (> 0))) xs
131139 return $ Prelude.length x
132140
133141{-# INLINE someAlt #-}
134142someAlt :: MonadCatch m => SerialT m Int -> m Int
135143someAlt xs = do
136− x <- IP.parseK (AP.some (satisfy (> 0))) xs
144+ x <- PARSE_OP (AP.some (satisfy (> 0))) xs
137145 return $ Prelude.length x
138146
139147{-# INLINE choice #-}
140148choice :: MonadCatch m => Int -> SerialT m Int -> m Int
141149choice value =
142− IP.parseK (asum (replicate value (satisfy (< 0)))
150+ PARSE_OP (asum (replicate value (satisfy (< 0)))
143151 AP.<|> satisfy (> 0))
144152
145153-------------------------------------------------------------------------------
benchmark/streamly-benchmarks.cabal+16
@@ -275,6 +275,22 @@ benchmark Data.Parser.ParserK
275275 buildable: True
276276 build-depends: exceptions >= 0.8 && < 0.11
277277
278+-- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that
279+-- the rewrite rules are disabled. We can also use the "no-fusion" build
280+-- flag but we need to keep in mind that it disables fusion for streams
281+-- as well.
282+benchmark Data.Parser.FromParserK
283+ import: bench-options
284+ type: exitcode-stdio-1.0
285+ hs-source-dirs: Streamly/Benchmark/Data/Parser
286+ cpp-options: -DFROM_PARSERK
287+ main-is: ParserK.hs
288+ if impl(ghcjs)
289+ buildable: False
290+ else
291+ buildable: True
292+ build-depends: exceptions >= 0.8 && < 0.11
293+
278294benchmark Data.Parser
279295 import: bench-options
280296 type: exitcode-stdio-1.0