git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs
163 lines 5.1 kB history raw
1-- |
2-- Module : Streamly.Benchmark.Data.ParserK
3-- Copyright : (c) 2020 Composewell Technologies
4--
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
11module Main
12 (
13 main
14 ) where
16import Control.DeepSeq (NFData(..))
17import Control.Monad.Catch (MonadCatch)
18import Data.Foldable (asum)
19import System.Random (randomRIO)
20import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
22import qualified Control.Applicative as AP
23import qualified Data.Foldable as F
24import qualified Data.Traversable as TR
25import qualified Streamly.Prelude as S
26import qualified Streamly.Internal.Data.Fold as FL
27import qualified Streamly.Internal.Data.Parser.ParserK.Type as PR
28import qualified Streamly.Internal.Data.Parser.ParserD as PRD
29import qualified Streamly.Internal.Data.Stream.IsStream as IP
31import Gauge
32import Streamly.Prelude (SerialT, MonadAsync, IsStream)
33import Streamly.Benchmark.Common
35-------------------------------------------------------------------------------
36-- Utilities
37-------------------------------------------------------------------------------
39-- XXX these can be moved to the common module
41{-# INLINE sourceUnfoldrM #-}
42sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
43sourceUnfoldrM value n = S.unfoldrM step n
44 where
45 step cnt =
46 if cnt > n + value
47 then return Nothing
48 else return (Just (cnt, cnt + 1))
50-- | Takes a fold method, and uses it with a default source.
51{-# INLINE benchIOSink #-}
52benchIOSink
53 :: (IsStream t, NFData b)
54 => Int -> String -> (t IO Int -> IO b) -> Benchmark
55benchIOSink value name f =
56 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
58-------------------------------------------------------------------------------
59-- Parsers
60-------------------------------------------------------------------------------
62#ifdef FROM_PARSERK
63#define PARSE_OP (IP.parseD . PR.fromParserK)
64#else
65#define PARSE_OP IP.parseK
66#endif
68{-# INLINE satisfy #-}
69satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
70satisfy = PR.toParserK . PRD.satisfy
72{-# INLINE takeWhile #-}
73takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
74takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
76{-# INLINE takeWhileK #-}
77takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
78takeWhileK value = PARSE_OP (takeWhile (<= value))
80{-# INLINE splitApp #-}
81splitApp :: MonadCatch m
82 => Int -> SerialT m Int -> m ((), ())
83splitApp value =
84 PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
86{-# INLINE sequenceA #-}
87sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
88sequenceA value xs = do
89 let parser = satisfy (> 0)
90 list = Prelude.replicate value parser
91 x <- PARSE_OP (TR.sequenceA list) xs
92 return $ Prelude.length x
94{-# INLINE sequenceA_ #-}
95sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
96sequenceA_ value xs = do
97 let parser = satisfy (> 0)
98 list = Prelude.replicate value parser
99 PARSE_OP (F.sequenceA_ list) xs
101{-# INLINE sequence #-}
102sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
103sequence value xs = do
104 let parser = satisfy (> 0)
105 list = Prelude.replicate value parser
106 x <- PARSE_OP (TR.sequence list) xs
107 return $ Prelude.length x
109{-# INLINE manyAlt #-}
110manyAlt :: MonadCatch m => SerialT m Int -> m Int
111manyAlt xs = do
112 x <- PARSE_OP (AP.many (satisfy (> 0))) xs
113 return $ Prelude.length x
115{-# INLINE someAlt #-}
116someAlt :: MonadCatch m => SerialT m Int -> m Int
117someAlt xs = do
118 x <- PARSE_OP (AP.some (satisfy (> 0))) xs
119 return $ Prelude.length x
121{-# INLINE choice #-}
122choice :: MonadCatch m => Int -> SerialT m Int -> m Int
123choice value =
124 PARSE_OP (asum (replicate value (satisfy (< 0)))
125 AP.<|> satisfy (> 0))
127-------------------------------------------------------------------------------
128-- Benchmarks
129-------------------------------------------------------------------------------
131moduleName :: String
132moduleName = "Data.Parser.ParserK"
134o_1_space_serial :: Int -> [Benchmark]
135o_1_space_serial value =
136 [ benchIOSink value "takeWhile" $ takeWhileK value
137 , benchIOSink value "splitApp" $ splitApp value
138 ]
140-- O(n) heap beacuse of accumulation of the list in strict IO monad?
141o_n_heap_serial :: Int -> [Benchmark]
142o_n_heap_serial value =
143 [ benchIOSink value "sequenceA" $ sequenceA value
144 , benchIOSink value "sequenceA_" $ sequenceA_ value
145 , benchIOSink value "sequence" $ sequence value
146 , benchIOSink value "manyAlt" manyAlt
147 , benchIOSink value "someAlt" someAlt
148 , benchIOSink value "choice" $ choice value
149 ]
151-------------------------------------------------------------------------------
152-- Driver
153-------------------------------------------------------------------------------
155main :: IO ()
156main = runWithCLIOpts defaultStreamSize allBenchmarks
158 where
160 allBenchmarks value =
161 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
162 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
163 ]