{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.Type.BitRecords.BitBuffer64
( type BitBuffer64MaxLength
, bitBuffer64MaxLength
, bitBuffer64MaxLengthBytes
, BitBuffer64()
, bitBuffer64Content
, bitBuffer64Length
, isBitBuffer64Empty
, bitBuffer64SpaceLeft
, bitBuffer64
, emptyBitBuffer64
, bitBuffer64ProxyLength
, bufferBits
, type KnownChunkSize
) where
import Data.Proxy
import Data.Bits
import Data.Word
import Data.Kind ( Constraint )
import GHC.TypeLits
type BitBuffer64MaxLength = 64
bitBuffer64MaxLength :: Int
bitBuffer64MaxLength = 64
bitBuffer64MaxLengthBytes :: Word64
bitBuffer64MaxLengthBytes = 8
data BitBuffer64 = BitBuffer64 !Word64 !Int
bitBuffer64Content :: BitBuffer64 -> Word64
bitBuffer64Content (BitBuffer64 !c _) =
c
bitBuffer64Length :: BitBuffer64 -> Int
bitBuffer64Length (BitBuffer64 _ !len) =
len
isBitBuffer64Empty :: BitBuffer64 -> Bool
isBitBuffer64Empty (BitBuffer64 _ !len) =
len == 0
bitBuffer64SpaceLeft :: BitBuffer64 -> Int
bitBuffer64SpaceLeft (BitBuffer64 _ !len) =
bitBuffer64MaxLength - len
bitBuffer64 :: Int -> Word64 -> BitBuffer64
bitBuffer64 !len !b =
BitBuffer64 (let !s = bitBuffer64MaxLength - len in ((b `unsafeShiftL` s) `unsafeShiftR` s)) len
emptyBitBuffer64 :: BitBuffer64
emptyBitBuffer64 = BitBuffer64 0 0
bitBuffer64ProxyLength :: (KnownChunkSize n) => Proxy n -> Word64 -> BitBuffer64
bitBuffer64ProxyLength !plen !v = bitBuffer64 fieldLen v
where
!fieldLen = fromIntegral (natVal plen)
bufferBits :: BitBuffer64
-> BitBuffer64
-> (BitBuffer64, BitBuffer64)
bufferBits (BitBuffer64 !bits !len) (BitBuffer64 !buff !offset) =
let !spaceAvailable = bitBuffer64MaxLength - offset
!writeLen = min spaceAvailable len
!writeOffset = spaceAvailable - writeLen
!restLen = len - writeLen
!restBits = bits .&. (1 `unsafeShiftL` restLen - 1)
!buff' = buff .|.
(bits `unsafeShiftR` restLen `unsafeShiftL` writeOffset)
in
(BitBuffer64 restBits restLen, BitBuffer64 buff' (offset + writeLen))
type family KnownChunkSize (s :: Nat) :: Constraint where
KnownChunkSize size = (KnownNat size, size <= BitBuffer64MaxLength)