git.iko.soy/typeable/aeson
on v1420 help sign in
typeable/aeson/benchmarks/Issue673.hs
164 lines 4.6 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
4module Main (
5 main,
6 input17,
7 input32,
8 input64,
9 input128,
10 input256,
11 input2048,
12 input4096,
13 input8192,
14 input16384,
15 ) where
17import Criterion.Main
18import Prelude.Compat
19import Data.Int (Int64)
20import Data.Scientific (Scientific)
21import Data.Aeson.Parser (scientific)
23import qualified Data.Attoparsec.ByteString.Lazy as AttoL
24import qualified Data.Attoparsec.ByteString.Char8 as Atto8
25import qualified Data.Aeson as A
26import qualified Data.ByteString as BS
27import qualified Data.ByteString.Lazy as LBS
28import qualified Data.ByteString.Lazy.Char8 as LBS8
30decodeInt :: LBS.ByteString -> Maybe Int
31decodeInt = A.decode
33decodeString :: LBS.ByteString -> Maybe String
34decodeString = A.decode
36decodeScientific :: LBS.ByteString -> Maybe Scientific
37decodeScientific = A.decode
39decodeViaRead :: LBS.ByteString -> Integer
40decodeViaRead = read . LBS8.unpack
42decodeAtto :: LBS.ByteString -> Maybe Scientific
43decodeAtto
44 = parseOnly (scientific <* AttoL.endOfInput)
45 where
46 parseOnly p lbs = case AttoL.parse p lbs of
47 AttoL.Done _ r -> Just r
48 AttoL.Fail {} -> Nothing
50decodeAtto8 :: LBS.ByteString -> Maybe Scientific
51decodeAtto8
52 = parseOnly (Atto8.scientific <* AttoL.endOfInput)
53 where
54 parseOnly p lbs = case AttoL.parse p lbs of
55 AttoL.Done _ r -> Just r
56 AttoL.Fail {} -> Nothing
58generate :: Int64 -> LBS.ByteString
59generate n = LBS8.replicate n '1'
61input17 :: LBS.ByteString
62input17 = generate 17
64input32 :: LBS.ByteString
65input32 = generate 32
67input64 :: LBS.ByteString
68input64 = generate 64
70input128 :: LBS.ByteString
71input128 = generate 128
73input256 :: LBS.ByteString
74input256 = generate 256
76input2048 :: LBS.ByteString
77input2048 = generate 2048
79input4096 :: LBS.ByteString
80input4096 = generate 4096
82input8192 :: LBS.ByteString
83input8192 = generate 8192
85input16384 :: LBS.ByteString
86input16384 = generate 16384
89main :: IO ()
90main = defaultMain
91 -- works on 64bit
92 [ benchPair "17" input17
93 -- , benchPair "32" input32
94 -- , benchPair "64" input64
95 -- , benchPair "128" input128
96 -- , benchPair "256" input256
97 , benchPair "2048" input2048
98 , benchPair "4096" input4096
99 , benchPair "8192" input8192
100 , benchPair "16384" input16384
101 ]
102 where
103 benchPair name input = bgroup name
104 [ bench "Int" $ whnf decodeInt input
105 , bench "Simple" $ whnf bsToIntegerSimple (LBS.toStrict input)
106 , bench "Optim" $ whnf bsToInteger (LBS.toStrict input)
107 , bench "Read" $ whnf decodeViaRead input
108 , bench "Scientific" $ whnf decodeScientific input
109 , bench "parserA" $ whnf decodeAtto input
110 , bench "parserS" $ whnf decodeAtto8 input
111 , bench "String" $ whnf decodeString $ "\"" <> input <> "\""
112 ]
114-------------------------------------------------------------------------------
115-- better fromInteger
116-------------------------------------------------------------------------------
118bsToInteger :: BS.ByteString -> Integer
119bsToInteger bs
120 | l > 40 = valInteger 10 l [ fromIntegral (w - 48) | w <- BS.unpack bs ]
121 | otherwise = bsToIntegerSimple bs
122 where
123 l = BS.length bs
125bsToIntegerSimple :: BS.ByteString -> Integer
126bsToIntegerSimple = BS.foldl' step 0 where
127 step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
129-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
130-- digits are combined into a single radix b^2 digit. This process is
131-- repeated until we are left with a single digit. This algorithm
132-- performs well only on large inputs, so we use the simple algorithm
133-- for smaller inputs.
134valInteger :: Integer -> Int -> [Integer] -> Integer
135valInteger = go
136 where
137 go :: Integer -> Int -> [Integer] -> Integer
138 go _ _ [] = 0
139 go _ _ [d] = d
140 go b l ds
141 | l > 40 = b' `seq` go b' l' (combine b ds')
142 | otherwise = valSimple b ds
143 where
144 -- ensure that we have an even number of digits
145 -- before we call combine:
146 ds' = if even l then ds else 0 : ds
147 b' = b * b
148 l' = (l + 1) `quot` 2
150 combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
151 where
152 d = d1 * b + d2
153 combine _ [] = []
154 combine _ [_] = errorWithoutStackTrace "this should not happen"
156-- The following algorithm is only linear for types whose Num operations
157-- are in constant time.
158valSimple :: Integer -> [Integer] -> Integer
159valSimple base = go 0
160 where
161 go r [] = r
162 go r (d : ds) = r' `seq` go r' ds
163 where
164 r' = r * base + fromIntegral d