git.iko.soy/streamly
on 4eaeb10 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs
162 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 (MonadThrow)
18import Data.Foldable (asum)
19import Streamly.Internal.Data.Stream (Stream)
20import System.Random (randomRIO)
21import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
23import qualified Control.Applicative as AP
24import qualified Data.Foldable as F
25import qualified Data.Traversable as TR
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 as Stream
31import Gauge
32import Streamly.Benchmark.Common
34-------------------------------------------------------------------------------
35-- Utilities
36-------------------------------------------------------------------------------
38-- XXX these can be moved to the common module
40{-# INLINE sourceUnfoldrM #-}
41sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
42sourceUnfoldrM value n = Stream.unfoldrM step n
43 where
44 step cnt =
45 if cnt > n + value
46 then return Nothing
47 else return (Just (cnt, cnt + 1))
49-- | Takes a fold method, and uses it with a default source.
50{-# INLINE benchIOSink #-}
51benchIOSink
52 :: NFData b
53 => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
54benchIOSink value name f =
55 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
57-------------------------------------------------------------------------------
58-- Parsers
59-------------------------------------------------------------------------------
61#ifdef FROM_PARSERK
62#define PARSE_OP (Stream.parseD . PRD.fromParserK)
63#else
64#define PARSE_OP Stream.parseK
65#endif
67{-# INLINE satisfy #-}
68satisfy :: Monad m => (a -> Bool) -> PR.Parser m a a
69satisfy = PRD.toParserK . PRD.satisfy
71{-# INLINE takeWhile #-}
72takeWhile :: Monad m => (a -> Bool) -> PR.Parser m a ()
73takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain
75{-# INLINE takeWhileK #-}
76takeWhileK :: MonadThrow m => Int -> Stream m Int -> m ()
77takeWhileK value = PARSE_OP (takeWhile (<= value))
79{-# INLINE splitApp #-}
80splitApp :: MonadThrow m
81 => Int -> Stream m Int -> m ((), ())
82splitApp value =
83 PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
85{-# INLINE sequenceA #-}
86sequenceA :: MonadThrow m => Int -> Stream m Int -> m Int
87sequenceA value xs = do
88 let parser = satisfy (> 0)
89 list = Prelude.replicate value parser
90 x <- PARSE_OP (TR.sequenceA list) xs
91 return $ Prelude.length x
93{-# INLINE sequenceA_ #-}
94sequenceA_ :: MonadThrow m => Int -> Stream m Int -> m ()
95sequenceA_ value xs = do
96 let parser = satisfy (> 0)
97 list = Prelude.replicate value parser
98 PARSE_OP (F.sequenceA_ list) xs
100{-# INLINE sequence #-}
101sequence :: MonadThrow m => Int -> Stream m Int -> m Int
102sequence value xs = do
103 let parser = satisfy (> 0)
104 list = Prelude.replicate value parser
105 x <- PARSE_OP (TR.sequence list) xs
106 return $ Prelude.length x
108{-# INLINE manyAlt #-}
109manyAlt :: MonadThrow m => Stream m Int -> m Int
110manyAlt xs = do
111 x <- PARSE_OP (AP.many (satisfy (> 0))) xs
112 return $ Prelude.length x
114{-# INLINE someAlt #-}
115someAlt :: MonadThrow m => Stream m Int -> m Int
116someAlt xs = do
117 x <- PARSE_OP (AP.some (satisfy (> 0))) xs
118 return $ Prelude.length x
120{-# INLINE choice #-}
121choice :: MonadThrow m => Int -> Stream m Int -> m Int
122choice value =
123 PARSE_OP (asum (replicate value (satisfy (< 0)))
124 AP.<|> satisfy (> 0))
126-------------------------------------------------------------------------------
127-- Benchmarks
128-------------------------------------------------------------------------------
130moduleName :: String
131moduleName = "Data.Parser.ParserK"
133o_1_space_serial :: Int -> [Benchmark]
134o_1_space_serial value =
135 [ benchIOSink value "takeWhile" $ takeWhileK value
136 , benchIOSink value "splitApp" $ splitApp value
137 ]
139-- O(n) heap beacuse of accumulation of the list in strict IO monad?
140o_n_heap_serial :: Int -> [Benchmark]
141o_n_heap_serial value =
142 [ benchIOSink value "sequenceA" $ sequenceA value
143 , benchIOSink value "sequenceA_" $ sequenceA_ value
144 , benchIOSink value "sequence" $ sequence value
145 , benchIOSink value "manyAlt" manyAlt
146 , benchIOSink value "someAlt" someAlt
147 , benchIOSink value "choice" $ choice value
148 ]
150-------------------------------------------------------------------------------
151-- Driver
152-------------------------------------------------------------------------------
154main :: IO ()
155main = runWithCLIOpts defaultStreamSize allBenchmarks
157 where
159 allBenchmarks value =
160 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
161 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
162 ]