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