castagnoli-0.2.0.0: src/Crc32c.hs

{-# language BangPatterns #-}
{-# language TypeApplications #-}

module Crc32c
  ( bytes
  , mutableBytes
  , chunks
  ) where

import Crc32c.Table (table)
import Data.Word (Word8,Word32)
import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes))
import Control.Monad.Primitive (PrimState,PrimMonad)
import Data.Bits (shiftR,xor)
import Data.Bytes.Chunks (Chunks(ChunksCons,ChunksNil))
import qualified Data.Primitive.ByteArray as PM
import qualified Data.Primitive.Ptr as PM

-- | Compute the checksum of a slice of bytes.
bytes :: Word32 -> Bytes -> Word32
bytes !acc0 (Bytes arr off len) =
  let go !acc !ix !end = if ix < end
        then go (step acc (PM.indexByteArray arr ix)) (ix + 1) end
        else acc
   in xor 0xFFFFFFFF (go (xor acc0 0xFFFFFFFF) off (off + len))

chunks :: Word32 -> Chunks -> Word32
chunks !acc ChunksNil = acc
chunks !acc (ChunksCons x xs) =
  let !acc' = bytes acc x
   in chunks acc' xs

-- | Compute the checksum of a slice of mutable bytes.
mutableBytes :: PrimMonad m
  => Word32
  -> MutableBytes (PrimState m)
  -> m Word32
{-# inlineable mutableBytes #-}
mutableBytes acc0 (MutableBytes arr off len) = do
  let go !acc !ix !end = if ix < end
        then do
          w <- PM.readByteArray arr ix
          go (step acc w) (ix + 1) end
        else pure acc
  r <- go (xor acc0 0xFFFFFFFF) off (off + len)
  pure (xor 0xFFFFFFFF r)

-- This might be revived one day.
--
-- x -- | Compute the checksum of a slice into an array of unsliced byte arrays.
-- x byteArrays :: Word32 -> UnliftedVector ByteArray -> Word32
-- x byteArrays !acc0 (UnliftedVector arr off len) =
-- x   let go !acc !ix !end = if ix < end
-- x         then
-- x           let b = PM.indexUnliftedArray arr ix
-- x            in go (bytes acc (Bytes b 0 (PM.sizeofByteArray b))) (ix + 1) end
-- x         else acc
-- x    in go acc0 off (off + len)
-- x 
-- x -- | Compute the checksum of a slice into an mutable array of
-- x -- unsliced byte arrays.
-- x mutableByteArrays :: PrimMonad m
-- x   => Word32
-- x   -> MutableUnliftedVector (PrimState m) ByteArray
-- x   -> m Word32
-- x {-# inlineable mutableByteArrays #-}
-- x mutableByteArrays acc0 (MutableUnliftedVector arr off len) =
-- x   let go !acc !ix !end = if ix < end
-- x         then do
-- x           b <- PM.readUnliftedArray arr ix
-- x           go (bytes acc (Bytes b 0 (PM.sizeofByteArray b))) (ix + 1) end
-- x         else pure acc
-- x    in go acc0 off (off + len)

step :: Word32 -> Word8 -> Word32
step !acc !w = xor
  (scramble (xor (fromIntegral @Word32 @Word8 acc) w))
  (shiftR acc 8)

scramble :: Word8 -> Word32
scramble w = PM.indexOffPtr table (fromIntegral @Word8 @Int w)