{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Codec.Compression.Zlib.Adler32 (
AdlerState,
initialAdlerState,
advanceAdler,
advanceAdlerBlock,
finalizeAdler,
) where
import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as S
import GHC.Exts (Word#, plusWord#, remWord#)
import GHC.Word (Word32 (..), Word8 (..))
data AdlerState = AdlerState {AdlerState -> Word#
_adlerA :: Word#, AdlerState -> Word#
_adlerB :: Word#}
initialAdlerState :: AdlerState
initialAdlerState :: AdlerState
initialAdlerState = Word# -> Word# -> AdlerState
AdlerState Word#
1## Word#
0##
advanceAdler :: AdlerState -> Word8 -> AdlerState
advanceAdler :: AdlerState -> Word8 -> AdlerState
advanceAdler (AdlerState Word#
a Word#
b) (W8# Word#
v) = Word# -> Word# -> AdlerState
AdlerState Word#
a' Word#
b'
where
a' :: Word#
a' = (Word#
a Word# -> Word# -> Word#
`plusWord#` Word#
v) Word# -> Word# -> Word#
`remWord#` Word#
65521##
b' :: Word#
b' = (Word#
b Word# -> Word# -> Word#
`plusWord#` Word#
a') Word# -> Word# -> Word#
`remWord#` Word#
65521##
{-# INLINE advanceAdler #-}
advanceNoMod :: AdlerState -> Word8 -> AdlerState
advanceNoMod :: AdlerState -> Word8 -> AdlerState
advanceNoMod (AdlerState Word#
a Word#
b) (W8# Word#
v) = Word# -> Word# -> AdlerState
AdlerState Word#
a' Word#
b'
where
a' :: Word#
a' = Word#
a Word# -> Word# -> Word#
`plusWord#` Word#
v
b' :: Word#
b' = Word#
b Word# -> Word# -> Word#
`plusWord#` Word#
a'
{-# INLINE advanceNoMod #-}
advanceAdlerLimited :: AdlerState -> S.ByteString -> AdlerState
advanceAdlerLimited :: AdlerState -> ByteString -> AdlerState
advanceAdlerLimited !AdlerState
state !ByteString
bl = Word# -> Word# -> AdlerState
AdlerState Word#
stateA' Word#
stateB'
where
!(AdlerState Word#
stateA Word#
stateB) = (AdlerState -> Word8 -> AdlerState)
-> AdlerState -> ByteString -> AdlerState
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' AdlerState -> Word8 -> AdlerState
advanceNoMod AdlerState
state ByteString
bl
stateA' :: Word#
stateA' = Word#
stateA Word# -> Word# -> Word#
`remWord#` Word#
65521##
stateB' :: Word#
stateB' = Word#
stateB Word# -> Word# -> Word#
`remWord#` Word#
65521##
advanceAdlerBlock :: AdlerState -> S.ByteString -> AdlerState
advanceAdlerBlock :: AdlerState -> ByteString -> AdlerState
advanceAdlerBlock !AdlerState
state !ByteString
bl
| ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = AdlerState
state
| ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = AdlerState -> Word8 -> AdlerState
advanceAdler AdlerState
state (ByteString -> Word8
S.head ByteString
bl)
| ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5552 = AdlerState -> ByteString -> AdlerState
advanceAdlerLimited AdlerState
state ByteString
bl
| Bool
otherwise = AdlerState -> ByteString -> AdlerState
advanceAdlerBlock (AdlerState -> ByteString -> AdlerState
advanceAdlerBlock AdlerState
state ByteString
first5551) ByteString
rest
where
(!ByteString
first5551, !ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
5551 ByteString
bl
finalizeAdler :: AdlerState -> Word32
finalizeAdler :: AdlerState -> Word32
finalizeAdler (AdlerState Word#
a Word#
b) = Word32
high Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
low
where
high :: Word32
high = (Word# -> Word32
W32# Word#
b) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
low :: Word32
low = Word# -> Word32
W32# Word#
a