Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
You can’t perform that action at this time.