Skip to content

Commit 0db7ec5

Browse files
harendra-kumarharendra-kumar
committed
Split parser benchmark module into smaller modules
1 parent c152c5a commit 0db7ec5

File tree

11 files changed

+1236
-912
lines changed

11 files changed

+1236
-912
lines changed

‎benchmark/Streamly/Benchmark/Data/Parser.hs‎

Lines changed: 63 additions & 822 deletions
Large diffs are not rendered by default.

‎benchmark/Streamly/Benchmark/Data/Parser/Alternative.hs‎

Lines changed: 261 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,261 @@
1+
#undef FUSION_CHECK
2+
#ifdef FUSION_CHECK
3+
{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
4+
#endif
5+
6+
-- |
7+
-- Module : Streamly.Benchmark.Data.Parser.Alternative
8+
-- Copyright : (c) 2020 Composewell Technologies
9+
--
10+
-- License : BSD-3-Clause
11+
-- Maintainer : streamly@composewell.com
12+
13+
{-# LANGUAGE CPP #-}
14+
{-# LANGUAGE FlexibleContexts #-}
15+
{-# LANGUAGE ScopedTypeVariables #-}
16+
{-# OPTIONS_GHC -Wno-orphans #-}
17+
18+
module Streamly.Benchmark.Data.Parser.Alternative
19+
(
20+
benchmarks
21+
) where
22+
23+
import Control.Applicative ((<|>))
24+
import Control.DeepSeq (NFData(..))
25+
import Streamly.Internal.Data.Fold (Fold(..))
26+
import Streamly.Internal.Data.Parser
27+
(ParseError(..), Parser(..), Initial(..), Step(..), Final(..))
28+
import Streamly.Internal.Data.Stream (Stream)
29+
import Test.Tasty.Bench (Benchmark)
30+
31+
import qualified Control.Applicative as AP
32+
import qualified Data.Foldable as F
33+
import qualified Streamly.Internal.Data.Fold as Fold
34+
import qualified Streamly.Internal.Data.Parser as PR
35+
import qualified Streamly.Data.Stream as Stream
36+
37+
import Streamly.Benchmark.Common
38+
39+
-------------------------------------------------------------------------------
40+
-- Parsers
41+
-------------------------------------------------------------------------------
42+
43+
{-# INLINE manyWordByEven #-}
44+
manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())
45+
manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)
46+
47+
{-# INLINE many #-}
48+
many :: Monad m => Stream m Int -> m (Either ParseError Int)
49+
many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
50+
51+
{-# INLINE some #-}
52+
some :: Monad m => Stream m Int -> m (Either ParseError Int)
53+
some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
54+
55+
{-# INLINE manyAlt #-}
56+
manyAlt :: Monad m => Stream m Int -> m Int
57+
manyAlt xs = do
58+
x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
59+
return $ Prelude.length x
60+
61+
{-# INLINE someAlt #-}
62+
someAlt :: Monad m => Stream m Int -> m Int
63+
someAlt xs = do
64+
x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
65+
return $ Prelude.length x
66+
67+
-- XXX dropWhile with applicative does not fuse
68+
-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
69+
{-# INLINE takeWhileFail #-}
70+
takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
71+
takeWhileFail predicate (Fold fstep finitial _ ffinal) =
72+
Parser step initial extract
73+
74+
where
75+
76+
initial = do
77+
res <- finitial
78+
return $ case res of
79+
Fold.Partial s -> IPartial s
80+
Fold.Done b -> IDone b
81+
82+
step s a =
83+
if predicate a
84+
then do
85+
fres <- fstep s a
86+
return
87+
$ case fres of
88+
Fold.Partial s1 -> SPartial 1 s1
89+
Fold.Done b -> SDone 1 b
90+
else return $ SError "fail"
91+
92+
extract s = fmap (FDone 0) (ffinal s)
93+
94+
{-# INLINE alt2 #-}
95+
alt2 :: Monad m
96+
=> Int -> Stream m Int -> m (Either ParseError ())
97+
alt2 value =
98+
Stream.parse
99+
(PR.alt
100+
(takeWhileFail (<= (value `div` 2)) Fold.drain)
101+
(PR.dropWhile (<= value))
102+
)
103+
104+
{-# INLINE alt4 #-}
105+
alt4 :: Monad m
106+
=> Int -> Stream m Int -> m (Either ParseError ())
107+
alt4 value =
108+
Stream.parse
109+
( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain
110+
<|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain
111+
<|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain
112+
<|> PR.dropWhile (<= value)
113+
)
114+
115+
{-# INLINE alt8 #-}
116+
alt8 :: Monad m
117+
=> Int -> Stream m Int -> m (Either ParseError ())
118+
alt8 value =
119+
Stream.parse
120+
( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain
121+
<|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain
122+
<|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain
123+
<|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain
124+
<|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain
125+
<|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain
126+
<|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain
127+
<|> PR.dropWhile (<= value)
128+
)
129+
130+
{-# INLINE alt16 #-}
131+
alt16 :: Monad m
132+
=> Int -> Stream m Int -> m (Either ParseError ())
133+
alt16 value =
134+
Stream.parse
135+
( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
136+
<|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
137+
<|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
138+
<|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
139+
<|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
140+
<|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
141+
<|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
142+
<|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
143+
<|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
144+
<|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
145+
<|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
146+
<|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
147+
<|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
148+
<|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
149+
<|> PR.dropWhile (<= value)
150+
)
151+
152+
{-# INLINE altSmall #-}
153+
altSmall :: Monad m
154+
=> Int -> Stream m Int -> m ()
155+
altSmall value =
156+
Stream.fold Fold.drain .
157+
Stream.parseMany
158+
(PR.alt
159+
(PR.satisfy (>= value) *> PR.die "alt")
160+
(PR.satisfy (<= value))
161+
)
162+
163+
{-
164+
{-# INLINE teeAllAny #-}
165+
teeAllAny :: Monad m
166+
=> Int -> Stream m Int -> m ((), ())
167+
teeAllAny value =
168+
Stream.parse
169+
(PR.teeWith (,)
170+
(PR.dropWhile (<= value))
171+
(PR.dropWhile (<= value))
172+
)
173+
174+
{-# INLINE teeFstAllAny #-}
175+
teeFstAllAny :: Monad m
176+
=> Int -> Stream m Int -> m ((), ())
177+
teeFstAllAny value =
178+
Stream.parse
179+
(PR.teeWithFst (,)
180+
(PR.dropWhile (<= value))
181+
(PR.dropWhile (<= value))
182+
)
183+
184+
{-# INLINE shortestAllAny #-}
185+
shortestAllAny :: Monad m
186+
=> Int -> Stream m Int -> m (Either ParseError ())
187+
shortestAllAny value =
188+
Stream.parse
189+
(PR.shortest
190+
(PR.dropWhile (<= value))
191+
(PR.dropWhile (<= value))
192+
)
193+
194+
{-# INLINE longestAllAny #-}
195+
longestAllAny :: Monad m
196+
=> Int -> Stream m Int -> m (Either ParseError ())
197+
longestAllAny value =
198+
Stream.parse
199+
(PR.longest
200+
(PR.dropWhile (<= value))
201+
(PR.dropWhile (<= value))
202+
)
203+
-}
204+
205+
-------------------------------------------------------------------------------
206+
-- Choice
207+
-------------------------------------------------------------------------------
208+
209+
-- choice using the "Alternative" instance with direct style parser type has
210+
-- quadratic performance complexity.
211+
--
212+
{-# INLINE choiceAsum #-}
213+
choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
214+
choiceAsum value =
215+
Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
216+
AP.<|> PR.satisfy (> 0))
217+
218+
{-
219+
{-# INLINE choice #-}
220+
choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
221+
choice value =
222+
Stream.parse
223+
(PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
224+
-}
225+
226+
-------------------------------------------------------------------------------
227+
-- Benchmarks
228+
-------------------------------------------------------------------------------
229+
230+
instance NFData ParseError where
231+
{-# INLINE rnf #-}
232+
rnf (ParseError x) = rnf x
233+
234+
benchmarks :: Int -> [(SpaceComplexity, Benchmark)]
235+
benchmarks value =
236+
[
237+
-- Alternative
238+
(SpaceO_1, benchIOSink value "alt2parseMany" $ altSmall value)
239+
, (SpaceO_1, benchIOSink value "alt2" $ alt2 value)
240+
, (SpaceO_1, benchIOSink value "alt4" $ alt4 value)
241+
, (SpaceO_1, benchIOSink value "alt8" $ alt8 value)
242+
, (SpaceO_1, benchIOSink value "alt16" $ alt16 value)
243+
244+
-- O_n as they accumulate the results in a list.
245+
, (HeapO_n, benchIOSink value "manyAlt" manyAlt)
246+
, (HeapO_n, benchIOSink value "someAlt" someAlt)
247+
, (SpaceO_n, benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100))
248+
-- , benchIOSink value "choice/100" $ choice (value `div` 100)
249+
250+
-- Sequential Repetition
251+
, (SpaceO_1, benchIOSink value "many" many)
252+
, (SpaceO_1, benchIOSink value "many (wordBy even)" $ manyWordByEven)
253+
, (SpaceO_1, benchIOSink value "some" some)
254+
255+
{-
256+
, benchIOSink value "tee" $ teeAllAny value
257+
, benchIOSink value "teeFst" $ teeFstAllAny value
258+
, benchIOSink value "shortest" $ shortestAllAny value
259+
, benchIOSink value "longest" $ longestAllAny value
260+
-}
261+
]

0 commit comments

Comments
 (0)