git.iko.soy/typeable/attoparsec
on master help sign in
Start off some warp-related benchmarks
commit13961cbcc3d5453f479d876f7a5ced6d9d335793 authorBryan O'Sullivan <bos@serpentine.com> dateTue 9 Sep 2014, 22:37 (12 years ago) parente9e7a2b
9 files changed+116−11
compare with master
unifiedsplit
attoparsec.cabal+6−2 benchmarks/Aeson.hs+2−1 benchmarks/Benchmarks.hs+2 benchmarks/Common.hs+10 benchmarks/HeadersByteString.hs+3−3 benchmarks/HeadersText.hs+3−3 benchmarks/Warp.hs+17 benchmarks/Warp/ReadInt.hs+67 benchmarks/attoparsec-benchmarks.cabal+6−2
attoparsec.cabal+6−2
@@ -117,6 +117,8 @@ benchmark benchmarks
117117 HeadersText
118118 Links
119119 Numbers
120+ Warp
121+ Warp.ReadInt
120122 ghc-options: -O2 -Wall
121123
122124 if flag(developer)
@@ -126,15 +128,17 @@ benchmark benchmarks
126128 array,
127129 base == 4.*,
128130 bytestring >= 0.10.4.0,
129− criterion >= 0.8.1.0,
131+ criterion >= 1.0,
130132 deepseq >= 1.1,
131133 directory,
132134 filepath,
135+ ghc-prim,
133136 parsec >= 3.1.2,
134137 scientific,
135138 text >= 1.1.1.0,
136139 unordered-containers,
137− vector
140+ vector,
141+ warp
138142
139143source-repository head
140144 type: git
benchmarks/Aeson.hs+2−1
@@ -10,6 +10,7 @@ module Aeson
1010import Data.ByteString.Builder
1111 (Builder, byteString, toLazyByteString, charUtf8, word8)
1212
13+import Common (pathTo)
1314import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)
1415import Control.DeepSeq (NFData(..))
1516import Control.Monad (forM)
@@ -340,7 +341,7 @@ toByteString = L.toStrict . toLazyByteString
340341
341342aeson :: IO Benchmark
342343aeson = do
343− let path = "json-data"
344+ path <- pathTo "json-data"
344345 names <- sort . filter (`notElem` [".", ".."]) <$> getDirectoryContents path
345346 benches <- forM names $ \name -> do
346347 bs <- B.readFile (path </> name)
benchmarks/Benchmarks.hs+2
@@ -11,6 +11,7 @@ import Numbers (numbers)
1111import Common (chunksOf)
1212import Text.Parsec.Text ()
1313import Text.Parsec.Text.Lazy ()
14+import qualified Warp
1415import qualified Aeson
1516import qualified Data.Attoparsec.ByteString as AB
1617import qualified Data.Attoparsec.ByteString.Char8 as AC
@@ -83,6 +84,7 @@ main = do
8384 , headersT
8485 , Links.links
8586 , numbers
87+ , Warp.benchmarks
8688 ]
8789
8890-- Benchmarks bind and (potential) bounds-check merging.
benchmarks/Common.hs+10
@@ -3,11 +3,14 @@
33
44module Common (
55 chunksOf
6+ , pathTo
67 , rechunkBS
78 , rechunkT
89 ) where
910
1011import Control.DeepSeq (NFData(rnf))
12+import System.Directory (doesDirectoryExist)
13+import System.FilePath ((</>))
1114import Text.Parsec (ParseError)
1215import qualified Data.ByteString as B
1316import qualified Data.ByteString.Lazy as BL
@@ -35,3 +38,10 @@ rechunkBS n = BL.fromChunks . map B.pack . chunksOf n . B.unpack
3538
3639rechunkT :: Int -> T.Text -> TL.Text
3740rechunkT n = TL.fromChunks . map T.pack . chunksOf n . T.unpack
41+
42+pathTo :: String -> IO FilePath
43+pathTo wat = do
44+ exists <- doesDirectoryExist "benchmarks"
45+ return $ if exists
46+ then "benchmarks" </> wat
47+ else wat
benchmarks/HeadersByteString.hs+3−3
@@ -2,7 +2,7 @@
22{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
33module HeadersByteString (headers) where
44
5−import Common (rechunkBS)
5+import Common (pathTo, rechunkBS)
66import Control.Applicative
77import Criterion.Main (bench, bgroup, nf)
88import Criterion.Types (Benchmark)
@@ -40,8 +40,8 @@ response = (,) <$> responseLine <*> many header
4040
4141headers :: IO Benchmark
4242headers = do
43− req <- B.readFile "http-request.txt"
44− resp <- B.readFile "http-response.txt"
43+ req <- B.readFile =<< pathTo "http-request.txt"
44+ resp <- B.readFile =<< pathTo "http-response.txt"
4545 let reql = rechunkBS 4 req
4646 respl = rechunkBS 4 resp
4747 return $ bgroup "headers" [
benchmarks/HeadersText.hs+3−3
@@ -2,7 +2,7 @@
22{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
33module HeadersText (headers) where
44
5−import Common (rechunkT)
5+import Common (pathTo, rechunkT)
66import Control.Applicative
77import Criterion.Main (bench, bgroup, nf)
88import Criterion.Types (Benchmark)
@@ -41,8 +41,8 @@ response = (,) <$> responseLine <*> many header
4141
4242headers :: IO Benchmark
4343headers = do
44− req <- T.readFile "http-request.txt"
45− resp <- T.readFile "http-response.txt"
44+ req <- T.readFile =<< pathTo "http-request.txt"
45+ resp <- T.readFile =<< pathTo "http-response.txt"
4646 let reql = rechunkT 4 req
4747 respl = rechunkT 4 resp
4848 return $ bgroup "headers" [
benchmarks/Warp.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Warp (benchmarks) where
4+
5+import Criterion.Main (bench, bgroup, nf)
6+import Criterion.Types (Benchmark)
7+import Data.ByteString (ByteString)
8+import Warp.ReadInt (readInt)
9+import qualified Data.Attoparsec.ByteString.Char8 as B
10+
11+benchmarks :: Benchmark
12+benchmarks = bgroup "warp" [
13+ bgroup "decimal" [
14+ bench "warp" $ nf (readInt :: ByteString -> Int) "31337"
15+ , bench "atto" $ nf (B.parse (B.decimal :: B.Parser Int)) "31337"
16+ ]
17+ ]
benchmarks/Warp/ReadInt.hsnew file+67
@@ -0,0 +1,67 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE MagicHash #-}
3+{-# LANGUAGE BangPatterns #-}
4+
5+-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
6+-- License : BSD3
7+
8+module Warp.ReadInt (
9+ readInt
10+ , readInt64
11+ ) where
12+
13+-- This function lives in its own file because the MagicHash pragma interacts
14+-- poorly with the CPP pragma.
15+
16+import Data.ByteString (ByteString)
17+import qualified Data.ByteString as S
18+import Data.Int (Int64)
19+import GHC.Prim
20+import GHC.Types
21+import GHC.Word
22+
23+{-# INLINE readInt #-}
24+readInt :: Integral a => ByteString -> a
25+readInt bs = fromIntegral $ readInt64 bs
26+
27+-- This function is used to parse the Content-Length field of HTTP headers and
28+-- is a performance hot spot. It should only be replaced with something
29+-- significantly and provably faster.
30+--
31+-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we
32+-- use Int64 here and then make a generic 'readInt' that allows conversion to
33+-- Int and Integer.
34+
35+{-# NOINLINE readInt64 #-}
36+readInt64 :: ByteString -> Int64
37+readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (mhDigitToInt c)) 0
38+ $ S.takeWhile isDigit bs
39+
40+data Table = Table !Addr#
41+
42+{-# NOINLINE mhDigitToInt #-}
43+mhDigitToInt :: Word8 -> Int
44+mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i)))
45+ where
46+ !(Table addr) = table
47+ table :: Table
48+ table = Table
49+ "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
50+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
51+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
52+ \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
53+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
54+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
55+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
56+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
57+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
58+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
59+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
60+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
61+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
62+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
63+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
64+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
65+
66+isDigit :: Word8 -> Bool
67+isDigit w = w >= 48 && w <= 57
benchmarks/attoparsec-benchmarks.cabal+6−2
@@ -14,18 +14,22 @@ executable attoparsec-benchmarks
1414 HeadersText
1515 Links
1616 Numbers
17+ Warp
18+ Warp.ReadInt
1719 hs-source-dirs: .. .
1820 ghc-options: -O2 -Wall -rtsopts
1921 build-depends:
2022 array,
2123 base == 4.*,
2224 bytestring >= 0.10.4.0,
23− criterion >= 0.8.1.0,
25+ criterion >= 1.0,
2426 deepseq >= 1.1,
2527 directory,
2628 filepath,
29+ ghc-prim,
2730 parsec >= 3.1.2,
2831 scientific >= 0.3.1,
2932 text >= 1.1.1.0,
3033 unordered-containers,
31− vector
34+ vector,
35+ warp