git.iko.soy/typeable/wai
on master help sign in
Merge pull request #48 from erikd/master

Replace MagicHash version of readInt with readDecimal_ from bytestring-lexing

commit1e0276120e0c138a23248d02210c001c51874795 authorMichael Snoyman <michael@snoyman.com> dateWed 8 Feb 2012, 06:26 (15 years ago) parentc82e85dc9dc29a
5 files changed+30−92
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp.hs+3−9 warp/ReadInt.hs−58 warp/runtests.hs+5−1 warp/test/readInt.hs+21−23 warp/warp.cabal+1−1
warp/Network/Wai/Handler/Warp.hs+3−9
@@ -60,7 +60,6 @@ module Network.Wai.Handler.Warp
6060 , T.initialize
6161#if TEST
6262 , takeHeaders
63− , readInt
6463#endif
6564 ) where
6665
@@ -116,9 +115,9 @@ import Control.Monad (forever, when)
116115import qualified Network.HTTP.Types as H
117116import qualified Data.CaseInsensitive as CI
118117import System.IO (hPrint, stderr)
119−import ReadInt (readInt64)
120118import qualified Data.IORef as I
121119import Data.String (IsString (..))
120+import qualified Data.ByteString.Lex.Integral as LI
122121
123122#if WINDOWS
124123import Control.Concurrent (threadDelay)
@@ -353,7 +352,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
353352 let len0 =
354353 case lookup "content-length" heads of
355354 Nothing -> 0
356− Just bs -> readInt bs
355+ Just bs -> LI.readDecimal_ bs
357356 let serverName' = takeUntil 58 host -- ':'
358357 rbody <-
359358 if len0 == 0
@@ -516,7 +515,7 @@ sendResponse th req conn r = sendResponse' r
516515 sendResponse' :: Response -> ResourceT IO Bool
517516 sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do
518517 (lengthyHeaders, cl) <-
519− case (readInt `fmap` lookup "content-length" hs, mpart) of
518+ case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of
520519 (Just cl, _) -> return (hs, cl)
521520 (Nothing, Nothing) -> do
522521 cl <- P.fileSize `fmap` P.getFileStatus fp
@@ -761,11 +760,6 @@ checkCR bs pos =
761760 else pos
762761{-# INLINE checkCR #-}
763762
764−readInt :: Integral a => ByteString -> a
765−readInt bs = fromIntegral $ readInt64 bs
766−{-# INLINE readInt #-}
767−
768−
769763-- | Call the inner function with a timeout manager.
770764withManager :: Int -- ^ timeout in microseconds
771765 -> (Manager -> IO a)
warp/ReadInt.hsdeleted−58
@@ -1,58 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}
2−
3−-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
4−-- License : BSD3
5−
6−module ReadInt (readInt64) where
7−
8−-- This function lives in its own file because the MagicHash pragma interacts
9−-- poorly with the CPP pragma.
10−
11−import Data.ByteString (ByteString)
12−import Data.Int (Int64)
13−import GHC.Prim
14−import GHC.Types
15−
16−import qualified Data.ByteString.Char8 as B
17−import qualified Data.Char as C
18−
19−-- This function is used to parse the Content-Length field of HTTP headers and
20−-- is a performance hot spot. It should only be replaced with something
21−-- significantly and provably faster.
22−--
23−-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we
24−-- use Int64 here and then make a generic 'readInt' that allows conversion to
25−-- Int and Integer.
26−
27−readInt64 :: ByteString -> Int64
28−readInt64 bs =
29− B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0
30− $ B.takeWhile C.isDigit bs
31−{- NOINLINE readInt64MH #-}
32−
33−data Table = Table !Addr#
34−
35−{- NOINLINE mhDigitToInt #-}
36−mhDigitToInt :: Char -> Int
37−mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))
38− where
39− !(Table addr) = table
40− table :: Table
41− table = Table
42− "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
43− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
44− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
45− \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
46− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
47− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
48− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
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\x00\x00\x00\x00\x00\x00\x00\x00\x00\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−
warp/runtests.hs+5−1
@@ -6,10 +6,11 @@ import Test.Framework.Providers.HUnit
66import Test.Framework.Providers.QuickCheck2
77import Test.HUnit hiding (Test)
88
9−import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
9+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
1010import Data.Enumerator (run_, ($$), enumList, run)
1111import Control.Exception (fromException)
1212import qualified Data.ByteString.Char8 as S8
13+import qualified Data.ByteString.Lex.Integral as LI
1314
1415main :: IO ()
1516main = defaultMain [testSuite]
@@ -41,3 +42,6 @@ caseTakeUntilBlankTooMany = do
4142caseTakeUntilBlankTooLarge = do
4243 x <- run $ (enumList 1 $ repeat "f") $$ takeHeaders
4344 assertException OverLargeHeader x
45+
46+
47+readInt = LI.readDecimal_
warp/test/readInt.hs+21−23
@@ -19,10 +19,7 @@ import qualified Data.ByteString.Char8 as B
1919import qualified Data.Char as C
2020import qualified Numeric as N
2121import qualified Test.QuickCheck as QC
22−
23−-- ReadInt is a module internal to Warp.
24−import qualified ReadInt as RI
25−
22+import qualified Data.ByteString.Lex.Integral as LI
2623
2724import GHC.Prim
2825import GHC.Types
@@ -55,21 +52,17 @@ readIntRaw =
5552 B.foldl' (\i c -> i * 10 + C.digitToInt c) 0
5653
5754
58−-- The best solution.
59−readIntTC :: Integral a => ByteString -> a
60−readIntTC bs = fromIntegral
61− $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
62−
55+-- The first good solution.
56+readInt64 :: ByteString -> Int64
57+readInt64 bs =
58+ B.foldl' (\i c -> i * 10 + fromIntegral (C.digitToInt c)) (0::Int64)
59+ $ B.takeWhile C.isDigit bs
6360
64−-- Three specialisations of readIntTC.
6561readInt :: ByteString -> Int
66−readInt = readIntTC
67−
68−readInt64 :: ByteString -> Int64
69−readInt64 = readIntTC
62+readInt bs = fromIntegral $ readInt64 bs
7063
7164readInteger :: ByteString -> Integer
72−readInteger = readIntTC
65+readInteger bs = fromIntegral $ readInt64 bs
7366
7467
7568-- MagicHash version suggested by Vincent Hanquez.
@@ -90,7 +83,7 @@ readIntegerMH = readIntMH
9083data Table = Table !Addr#
9184
9285mhDigitToInt :: Char -> Int
93−mhDigitToInt (C# i) = I# (word2Int# $ indexWord8OffAddr# addr (ord# i))
86+mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))
9487 where
9588 !(Table addr) = table
9689 table :: Table
@@ -113,9 +106,11 @@ mhDigitToInt (C# i) = I# (word2Int# $ indexWord8OffAddr# addr (ord# i))
113106 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
114107
115108
116−-- This is the one Warp actually uses.
117−readIntWarp :: ByteString -> Integer
118−readIntWarp s = fromIntegral $ RI.readInt64 s
109+readIntBSL :: ByteString -> Int
110+readIntBSL = LI.readDecimal_
111+
112+readInt64BSL :: ByteString -> Int64
113+readInt64BSL = LI.readDecimal_
119114
120115
121116-- A QuickCheck property. Test that for a number >= 0, converting it to
@@ -124,7 +119,7 @@ readIntWarp s = fromIntegral $ RI.readInt64 s
124119-- The functions under test only work on Natural numbers (the Conent-Length
125120-- field in a HTTP header is always >= 0) so we check the absolute value of
126121-- the value that QuickCheck generates for us.
127−prop_read_show_idempotent :: Integral a => (ByteString -> a) -> a -> Bool
122+prop_read_show_idempotent :: (Integral a, Show a) => (ByteString -> a) -> a -> Bool
128123prop_read_show_idempotent freader x =
129124 let px = abs x
130125 in px == freader (B.pack $ show px)
@@ -137,8 +132,8 @@ runQuickCheckTests = do
137132 QC.quickCheck (prop_read_show_idempotent readInteger)
138133 QC.quickCheck (prop_read_show_idempotent readInt64MH)
139134 QC.quickCheck (prop_read_show_idempotent readIntegerMH)
140− QC.quickCheck (prop_read_show_idempotent readIntWarp)
141−
135+ QC.quickCheck (prop_read_show_idempotent readIntBSL)
136+ QC.quickCheck (prop_read_show_idempotent readInt64BSL)
142137
143138runCriterionTests :: ByteString -> IO ()
144139runCriterionTests number =
@@ -152,7 +147,10 @@ runCriterionTests number =
152147 , bench "readInteger" $ nf readInteger number
153148 , bench "readInt64MH" $ nf readInt64MH number
154149 , bench "readIntegerMH" $ nf readIntegerMH number
155− , bench "readIntWarp" $ nf readIntWarp number
150+
151+ -- Current best.
152+ , bench "readIntBSL" $ nf readIntBSL number
153+ , bench "readInt64BSL" $ nf readInt64BSL number
156154 ]
157155
158156main :: IO ()
warp/warp.cabal+1−1
@@ -29,6 +29,7 @@ Library
2929 , http-types >= 0.6 && < 0.7
3030 , case-insensitive >= 0.2
3131 , unix-compat >= 0.2
32+ , bytestring-lexing >= 0.4
3233 , ghc-prim
3334 if flag(network-bytestring)
3435 build-depends: network >= 2.2.1.5 && < 2.2.3
@@ -37,7 +38,6 @@ Library
3738 build-depends: network >= 2.3 && < 2.4
3839 Exposed-modules: Network.Wai.Handler.Warp
3940 Other-modules: Timeout
40− ReadInt
4141 Paths_warp
4242 ghc-options: -Wall
4343 if os(windows)