module Data.Type.BitRecords.Builder.BitBuffer
( type BitStringMaxLength
, type ModuloBitStringMaxLength
, bitStringMaxLength
, bitStringMaxLengthBytes
, BitString()
, bitStringContent
, bitStringLength
, isBitStringEmpty
, bitStringSpaceLeft
, bitString
, emptyBitString
, bitStringProxyLength
, BitStringBuilderChunk()
, bitStringBuilderChunkContent
, bitStringBuilderChunkLength
, isBitStringBuilderChunkEmpty
, bitStringBuilderChunkSpaceLeft
, bitStringBuilderChunk
, emptyBitStringBuilderChunk
, bufferBits
, type KnownChunkSize
) where
import Data.Proxy
import Data.Type.BitRecords.Arithmetic
import Data.Bits
import Data.Word
import Data.Kind ( Constraint )
import GHC.TypeLits
type BitStringMaxLength = 64
type family ModuloBitStringMaxLength (len :: Nat) :: Nat where
ModuloBitStringMaxLength len = len `RemPow2` 6
bitStringMaxLength :: Num a => a
bitStringMaxLength = 64
bitStringMaxLengthBytes :: Word64
bitStringMaxLengthBytes = 8
data BitString = BitString !Word64 !Int
bitStringContent :: BitString -> Word64
bitStringContent (BitString !c _) =
c
bitStringLength :: BitString -> Int
bitStringLength (BitString _ !len) =
len
isBitStringEmpty :: BitString -> Bool
isBitStringEmpty (BitString _ !len) =
len == 0
bitStringSpaceLeft :: BitString -> Int
bitStringSpaceLeft (BitString _ !len) =
bitStringMaxLength len
bitString :: Int -> Word64 -> BitString
bitString !len !b = BitString (let !s = bitStringMaxLength len in ((b `unsafeShiftL` s) `unsafeShiftR` s)) len
emptyBitString :: BitString
emptyBitString = BitString 0 0
data BitStringBuilderChunk = BitStringBuilderChunk !Word64 !Int
bitStringBuilderChunkContent :: BitStringBuilderChunk -> Word64
bitStringBuilderChunkContent (BitStringBuilderChunk !c _) =
c
bitStringBuilderChunkLength :: BitStringBuilderChunk -> Int
bitStringBuilderChunkLength (BitStringBuilderChunk _ !len) =
len
isBitStringBuilderChunkEmpty :: BitStringBuilderChunk -> Bool
isBitStringBuilderChunkEmpty (BitStringBuilderChunk _ !len) =
len == 0
bitStringBuilderChunkSpaceLeft :: BitStringBuilderChunk -> Int
bitStringBuilderChunkSpaceLeft (BitStringBuilderChunk _ !len) =
bitStringMaxLength len
bitStringBuilderChunk :: Word64 -> Int -> BitStringBuilderChunk
bitStringBuilderChunk !b !len = BitStringBuilderChunk b len
emptyBitStringBuilderChunk :: BitStringBuilderChunk
emptyBitStringBuilderChunk = BitStringBuilderChunk 0 0
bitStringProxyLength :: (KnownChunkSize n) => Proxy n -> Word64 -> BitString
bitStringProxyLength !plen !v = bitString fieldLen v
where
!fieldLen = fromIntegral (natVal plen)
bufferBits :: BitString
-> BitStringBuilderChunk
-> (BitString, BitStringBuilderChunk)
bufferBits (BitString !bits !len) (BitStringBuilderChunk !buff !offset) =
let !spaceAvailable = bitStringMaxLength 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
(BitString restBits restLen, BitStringBuilderChunk buff' (offset + writeLen))
type family KnownChunkSize (s :: Nat) :: Constraint where
KnownChunkSize size = (KnownNat size, size <= BitStringMaxLength)