Skip to content

Instantly share code, notes, and snippets.

@NathanHowell
Created January 24, 2012 06:17
Show Gist options
  • Save NathanHowell/1668317 to your computer and use it in GitHub Desktop.
Save NathanHowell/1668317 to your computer and use it in GitHub Desktop.
Benchmarking and QuickChecking readInt.
#line 1 "ParseInt64.rl"
#include <HsFFI.h>
#line 7 "ParseInt64.c"
static const int ParseInt64_start = 1;
static const int ParseInt64_first_final = 3;
static const int ParseInt64_error = 0;
static const int ParseInt64_en_main = 1;
#line 6 "ParseInt64.rl"
HsBool parseInt64(const HsWord8* buffer, HsInt off, HsInt length, HsInt64* value)
{
const HsWord8* p = &buffer[off];
const HsWord8* pe = &buffer[off+length];
int cs;
HsInt64 val = 0;
int neg = 0;
#line 28 "ParseInt64.c"
{
cs = ParseInt64_start;
}
#line 33 "ParseInt64.c"
{
if ( p == pe )
goto _test_eof;
switch ( cs )
{
case 1:
switch( (*p) ) {
case 43: goto st2;
case 45: goto tr2;
}
if ( 48 <= (*p) && (*p) <= 57 )
goto tr3;
goto st0;
st0:
cs = 0;
goto _out;
tr2:
#line 18 "ParseInt64.rl"
{
neg = 1;
}
goto st2;
st2:
if ( ++p == pe )
goto _test_eof2;
case 2:
#line 60 "ParseInt64.c"
if ( 48 <= (*p) && (*p) <= 57 )
goto tr3;
goto st0;
tr3:
#line 22 "ParseInt64.rl"
{
const HsInt64 old = val;
val = val * 10 + ((*p) - '0');
if (val < old) {
return HS_BOOL_FALSE;
}
}
goto st3;
st3:
if ( ++p == pe )
goto _test_eof3;
case 3:
#line 78 "ParseInt64.c"
switch( (*p) ) {
case 0: goto st4;
case 13: goto st4;
case 32: goto st4;
}
if ( (*p) > 10 ) {
if ( 48 <= (*p) && (*p) <= 57 )
goto tr3;
} else if ( (*p) >= 9 )
goto st4;
goto st0;
st4:
if ( ++p == pe )
goto _test_eof4;
case 4:
switch( (*p) ) {
case 0: goto st4;
case 13: goto st4;
case 32: goto st4;
}
if ( 9 <= (*p) && (*p) <= 10 )
goto st4;
goto st0;
}
_test_eof2: cs = 2; goto _test_eof;
_test_eof3: cs = 3; goto _test_eof;
_test_eof4: cs = 4; goto _test_eof;
_test_eof: {}
_out: {}
}
#line 35 "ParseInt64.rl"
if (neg > 0) {
val *= -1;
}
if (cs < ParseInt64_first_final) {
return HS_BOOL_FALSE;
}
*value = val;
return HS_BOOL_TRUE;
}
{-# LANGUAGE OverloadedStrings #-}
-- A program to QuickCheck and benchmark a function used in the Warp web server
-- and elsewhere to read the Content-Length field of HTTP headers.
--
-- Compile and run as:
-- ghc -Wall -O3 --make readInt.hs -o readInt && ./readInt
import Criterion.Main
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Int (Int64)
import Foreign.Marshal.Alloc (alloca)
import Foreign.C.Types (CChar)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable, peek)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C
import qualified Numeric as N
import qualified Test.QuickCheck as QC
-- This is the absolute mimimal solution. It will return garbage if the
-- imput string contains anything other than ASCI digits.
readIntOrig :: ByteString -> Integer
readIntOrig =
S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
-- Using Numeric.readDec which works on String, so the ByteString has to be
-- unpacked first.
readDec :: ByteString -> Integer
readDec s =
case N.readDec (B.unpack s) of
[] -> 0
(x, _):_ -> x
-- No checking for non-digits. Will overflow at 2^31 on 32 bit CPUs.
readIntRaw :: ByteString -> Int
readIntRaw =
B.foldl' (\i c -> i * 10 + C.digitToInt c) 0
-- The best solution.
readIntTC :: Integral a => ByteString -> a
readIntTC bs = fromIntegral
$ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
-- Three specialisations of readIntTC.
readInt :: ByteString -> Int
readInt = readIntTC
readInt64 :: ByteString -> Int64
readInt64 = readIntTC
readInteger :: ByteString -> Integer
readInteger = readIntTC
foreign import ccall "parseInt64"
c'parseInt64 :: Ptr CChar -> Int -> Int -> Ptr Int64 -> IO Bool
parseWith
:: (Integral a, Storable a)
=> (Ptr CChar -> Int -> Int -> Ptr a -> IO Bool)
-> ByteString
-> IO a
{-# SPECIALIZE parseWith :: (Ptr CChar -> Int -> Int -> Ptr Int64 -> IO Bool) -> ByteString -> IO Int64 #-}
parseWith ffi buff =
unsafeUseAsCStringLen buff $ \ (ptr, len) ->
alloca $ \ val -> do
ok <- ffi ptr 0 (fromIntegral len) val
if ok == False
then return 0
else do
val' <- peek val
return (fromIntegral val')
-- A QuickCheck property. Test that for a number >= 0, converting it to
-- a string using show and then reading the value back with the function
-- under test returns the original value.
-- The functions under test only work on Natural numbers (the Conent-Length
-- field in a HTTP header is always >= 0) so we check the absolute value of
-- the value that QuickCheck generates for us.
prop_read_show_idempotent :: Integral a => (ByteString -> a) -> a -> Bool
prop_read_show_idempotent freader x =
let px = abs x
in px == freader (B.pack $ show px)
runQuickCheckTests :: IO ()
runQuickCheckTests = do
QC.quickCheck (prop_read_show_idempotent readInt)
QC.quickCheck (prop_read_show_idempotent readInt64)
QC.quickCheck (prop_read_show_idempotent readInteger)
runCriterionTests :: ByteString -> IO ()
runCriterionTests number =
defaultMain
[ bench "readIntOrig" $ nf readIntOrig number
, bench "readDec" $ nf readDec number
, bench "readRaw" $ nf readIntRaw number
, bench "readInt" $ nf readInt number
, bench "readInt64" $ nf readInt64 number
, bench "readInteger" $ nf readInteger number
, bench "c'readInt64" $ nfIO (parseWith c'parseInt64 number)
]
main :: IO ()
main = do
putStrLn "Quickcheck tests."
runQuickCheckTests
putStrLn "Criterion tests."
runCriterionTests "1234567898765432178979128361238162386182"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment