public
Last active

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
{-# 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.