git.iko.soy/typeable/wai
on wai-handler-launch/3.0.2 help sign in
typeable/wai/warp/attic/readInt.hs
162 lines 5.8 kB history raw
1{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}
3-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
4-- License : BSD3
6-- A program to QuickCheck and benchmark a function used in the Warp web server
7-- and elsewhere to read the Content-Length field of HTTP headers.
8--
9-- Compile and run as:
10-- ghc -Wall -O3 --make readInt.hs -o readInt && ./readInt
12import Criterion.Main
13import Data.ByteString (ByteString)
14import Data.Int (Int64)
15import Data.Maybe (fromMaybe)
17import qualified Data.ByteString as S
18import qualified Data.ByteString.Char8 as B
19import qualified Data.Char as C
20import qualified Numeric as N
21import qualified Test.QuickCheck as QC
22import qualified Data.ByteString.Lex.Integral as LI
24import GHC.Prim
25import GHC.Types
27-- This is the absolute mimimal solution. It will return garbage if the
28-- imput string contains anything other than ASCI digits.
29readIntOrig :: ByteString -> Integer
30readIntOrig =
31 S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
34-- Using Numeric.readDec which works on String, so the ByteString has to be
35-- unpacked first.
36readDec :: ByteString -> Integer
37readDec s =
38 case N.readDec (B.unpack s) of
39 [] -> 0
40 (x, _):_ -> x
43-- Use ByteString's readInteger function (which requires some extra stuff to
44-- slow us down).
45readIntegerBS :: ByteString -> Integer
46readIntegerBS bs = fst $ fromMaybe (0, "") $ B.readInteger bs
49-- No checking for non-digits. Will overflow at 2^31 on 32 bit CPUs.
50readIntRaw :: ByteString -> Int
51readIntRaw =
52 B.foldl' (\i c -> i * 10 + C.digitToInt c) 0
55-- The first good solution.
56readInt64 :: ByteString -> Int64
57readInt64 bs =
58 B.foldl' (\i c -> i * 10 + fromIntegral (C.digitToInt c)) (0::Int64)
59 $ B.takeWhile C.isDigit bs
61readInt :: ByteString -> Int
62readInt bs = fromIntegral $ readInt64 bs
64readInteger :: ByteString -> Integer
65readInteger bs = fromIntegral $ readInt64 bs
68-- MagicHash version suggested by Vincent Hanquez.
69readIntMH :: Integral a => ByteString -> a
70readIntMH s = fromIntegral $ ireadInt64MH s
71 where
72 ireadInt64MH :: ByteString -> Int64
73 ireadInt64MH bs =
74 B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0
75 $ B.takeWhile C.isDigit bs
77readInt64MH :: ByteString -> Int64
78readInt64MH = readIntMH
80readIntegerMH :: ByteString -> Integer
81readIntegerMH = readIntMH
83data Table = Table !Addr#
85mhDigitToInt :: Char -> Int
86mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))
87 where
88 !(Table addr) = table
89 table :: Table
90 table = Table
91 "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
92 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
93 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
94 \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
95 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
96 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
97 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
98 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
99 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
100 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
101 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
102 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
103 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
104 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
105 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
106 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
109readIntBSL :: ByteString -> Int
110readIntBSL = LI.readDecimal_
112readInt64BSL :: ByteString -> Int64
113readInt64BSL = LI.readDecimal_
116-- A QuickCheck property. Test that for a number >= 0, converting it to
117-- a string using show and then reading the value back with the function
118-- under test returns the original value.
119-- The functions under test only work on Natural numbers (the Conent-Length
120-- field in a HTTP header is always >= 0) so we check the absolute value of
121-- the value that QuickCheck generates for us.
122prop_read_show_idempotent :: (Integral a, Show a) => (ByteString -> a) -> a -> Bool
123prop_read_show_idempotent freader x =
124 let px = abs x
125 in px == freader (B.pack $ show px)
128runQuickCheckTests :: IO ()
129runQuickCheckTests = do
130 QC.quickCheck (prop_read_show_idempotent readInt)
131 QC.quickCheck (prop_read_show_idempotent readInt64)
132 QC.quickCheck (prop_read_show_idempotent readInteger)
133 QC.quickCheck (prop_read_show_idempotent readInt64MH)
134 QC.quickCheck (prop_read_show_idempotent readIntegerMH)
135 QC.quickCheck (prop_read_show_idempotent readIntBSL)
136 QC.quickCheck (prop_read_show_idempotent readInt64BSL)
138runCriterionTests :: ByteString -> IO ()
139runCriterionTests number =
140 defaultMain
141 [ bench "readIntOrig" $ nf readIntOrig number
142 , bench "readDec" $ nf readDec number
143 , bench "readIntegerBS" $ nf readIntegerBS number
144 , bench "readRaw" $ nf readIntRaw number
145 , bench "readInt" $ nf readInt number
146 , bench "readInt64" $ nf readInt64 number
147 , bench "readInteger" $ nf readInteger number
148 , bench "readInt64MH" $ nf readInt64MH number
149 , bench "readIntegerMH" $ nf readIntegerMH number
151 -- Current best.
152 , bench "readIntBSL" $ nf readIntBSL number
153 , bench "readInt64BSL" $ nf readInt64BSL number
154 ]
156main :: IO ()
157main = do
158 putStrLn "Quickcheck tests."
159 runQuickCheckTests
160 putStrLn "Criterion tests."
161 runCriterionTests "1234567898765432178979128361238162386182"