Skip to content

@tsuraan /gist:1011151
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
{-# LANGUAGE BangPatterns #-}
import Data.Digest.Adler32 (adler32)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Criterion.Main
import System.IO
import Data.Word
import Data.Bits
-- using instead of generic Strict Pair (c.f. High-Performance Haskell) lets
-- us complete in about 70% the time
data IntWord = IW {-# UNPACK #-} !Int
{-# UNPACK #-} !Word32
modAdler32 :: Word32
modAdler32 = 65521
updateHash :: Word32 -> Word8 -> Word32 -> Word8 -> Word32
updateHash winlen !old8 !hash word8 =
let old = {-# SCC "convertOld" #-} fromIntegral old8
word = {-# SCC "convertWord" #-} fromIntegral word8
limit = {-# SCC "getLimit" #-} modAdler32
low = {-# SCC "getLow" #-} hash .&. 0xffff
high = {-# SCC "getHigh" #-} (hash `shiftR` 16) .&. 0xffff
nlow'' = {-# SCC "addLow" #-} low + word
nlow' = {-# SCC "truncLow" #-} if nlow'' > limit
then nlow'' - limit
else nlow''
nlow = {-# SCC "remOldLow" #-} if nlow' > old
then nlow' - old
else limit + nlow' - old
nhigh'' = {-# SCC "addHigh" #-} high + nlow'
nhigh' = {-# SCC "truncHigh" #-} if nhigh'' > limit
then nhigh'' - limit
else nhigh''
-- winlen < 256, so tosub is never more than 255 * 256 and is thus less
-- than the modAdler32 limit
tosub = {-# SCC "calcSub" #-} (1 + winlen) * old
nhigh = {-# SCC "subSub" #-} if nhigh' > tosub
then nhigh' - tosub
else limit + nhigh' - tosub
success = {-# SCC "genHash" #-} (nhigh `shiftL` 16) .|. nlow
in
if winlen < 256
then success
else error "Window length must be less than 256"
updateHash' :: ByteString -> Word32 -> Int -> Word32 -> Word8 -> Word32
updateHash' bs winlen oldpos =
updateHash winlen old
where
old = {-# SCC "BS.index" #-} (BS.index bs oldpos)
runWindow :: Word32 -> ByteString -> Word32
runWindow winlen bs =
let (inits, rest) = BS.splitAt (fromIntegral winlen) bs
updatefn :: IntWord -> Word8 -> IntWord
updatefn = \(IW oldp hash) word ->
IW (oldp + 1) (updateHash' bs winlen oldp hash word)
IW _ w = BS.foldl updatefn (IW 0 (adler32 inits)) rest
in w
main = do
bytes <- withFile "/dev/urandom" ReadMode ((flip BS.hGet) 16777216)
defaultMain [ bgroup "adler32" [ bench "works?" $ nf (runWindow 128) bytes ]]
--return $! runWindow 128 bytes
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.