{-# LANGUAGE
- UnboxedTuples
+ BangPatterns
+ , UnboxedTuples
, UnicodeSyntax
#-}
-- | Lazy bitstrings based on 'L.ByteString' which treats a byte
-- * Construction
, (∅)
+ , empty
, singleton
-- * Basic Interface
-- * Conversion from/to 'L.ByteString'
, fromByteString
, toByteString
+
+ -- * Substrings
+ , take
+ , drop
+ , splitAt
)
where
import qualified Data.ByteString.Lazy as L
import Data.Int
import qualified Data.Strict as S
import Data.Word
-import Prelude hiding (head, length, null, tail)
+import Prelude hiding (drop, head, length, null, splitAt, tail, take)
import Prelude.Unicode
-- | The BitString Type.
, rightBytes ∷ !L.ByteString
, rightRem ∷ !Remnant
}
- deriving (Eq, Show)
+ deriving Show
+
+-- | /O(n)/ The bitstrings must have finite lengths to test the
+-- equality.
+instance Eq BitString where
+ a == b = leftRem a' ≡ leftRem b' ∧
+ leftBytes a' ≡ leftBytes b' ∧
+ rightRem a' ≡ rightRem b'
+ where
+ a' = normalise a
+ b' = normalise b
+
+normalise ∷ BitString → BitString
+normalise bs
+ | remLen (leftRem bs) ≡ 8
+ = normalise $ bs {
+ leftRem = remEmpty
+ , leftBytes = L.cons (remByte $ leftRem bs) $ leftBytes bs
+ }
+ | remLen (rightRem bs) ≡ 8
+ = normalise $ bs {
+ rightBytes = L.cons (remByte $ rightRem bs) $ rightBytes bs
+ , rightRem = remEmpty
+ }
+ | otherwise
+ = bs {
+ leftBytes = leftBytes bs `L.append` (L.reverse $ rightBytes bs)
+ , rightBytes = L.empty
+ }
data Remnant
= Remnant {
-- | bit length from 0 to 8
remLen ∷ !Int
- -- | current byte
+ -- | current byte @(0 <= remByte <= (1 `'shiftL'` 'remLen') - 1)@
, remByte ∷ !Word8
}
deriving (Eq, Show)
in
(# r', S.Nothing #)
where
- w' = (remByte r `shiftR` 1)
+ w' = (remByte r `shiftL` 1)
.|.
if b then 1 else 0
unconsRem ∷ Remnant → (# S.Maybe Bool, Remnant #)
unconsRem r
| remNull r = (# S.Nothing, remEmpty #)
- | otherwise = let !b = remByte r `testBit` 1
+ | otherwise = let !b = remByte r `testBit` 0
!r' = Remnant {
remLen = remLen r - 1
, remByte = remByte r `shiftR` 1
unconsBytes ∷ L.ByteString → (# S.Maybe Remnant, L.ByteString #)
unconsBytes bs
= case L.uncons bs of
- Just (w, bs')
+ Just (!w, bs')
→ (# S.Just (byteToRem w), bs' #)
Nothing
→ (# S.Nothing, L.empty #)
--- | /O(1)/ The empty 'BitString'.
+appendRem ∷ Remnant → Remnant → Remnant
+appendRem a b = Remnant {
+ remLen = remLen a + remLen b
+ , remByte = (remByte a `shiftL` remLen b) .|. remByte b
+ }
+
+splitRemAt ∷ Integral n ⇒ n → Remnant → (# S.Maybe Remnant, Remnant #)
+splitRemAt n r
+ | remLen r ≥ fromIntegral n
+ = let !h = Remnant {
+ remLen = fromIntegral n
+ , remByte = remByte r .&. ((1 `shiftL` fromIntegral n) - 1)
+ }
+ !r' = Remnant {
+ remLen = remLen r - fromIntegral n
+ , remByte = remByte r `shiftR` fromIntegral n
+ }
+ in
+ (# S.Just h, r' #)
+ | otherwise
+ = (# S.Nothing, remEmpty #)
+
+-- | /O(1)/ The same as 'empty'.
(∅) ∷ BitString
-(∅) = BitString {
- leftRem = remEmpty
- , leftBytes = L.empty
- , rightBytes = L.empty
- , rightRem = remEmpty
- }
+(∅) = empty
+
+-- | /O(1)/ The empty 'BitString'.
+empty ∷ BitString
+empty = BitString {
+ leftRem = remEmpty
+ , leftBytes = L.empty
+ , rightBytes = L.empty
+ , rightRem = remEmpty
+ }
-- | /O(1)/ Convert a 'Bool' into a 'BitString'.
singleton ∷ Bool → BitString
-- | /O(1)/ Test whether a 'BitString' is empty.
null ∷ BitString → Bool
null bs
- = remLen (leftRem bs) ≡ 0
+ = remNull (leftRem bs)
∧
L.null (leftBytes bs)
∧
L.null (rightBytes bs)
∧
- remLen (rightRem bs) ≡ 0
+ remNull (rightRem bs)
--- | /O(n)/ Return the number of bits in a 'BitString'.
+-- | /O(n)/ @'length' bs@ returns the number of bits in @bs@. @bs@
+-- must have a finite length.
length ∷ Integral n ⇒ BitString → n
length bs
= fromIntegral $ ( fromIntegral (remLen $ leftRem bs)
, rightRem = remEmpty
}
--- | /O(n)/ Convert a 'BitString' into 'L.ByteString', padding
--- incomplete bytes to single bytes with necessary 0's at their
--- MSB. Thus the following equation does not hold when the length of
--- 'BitString' isn't multiple of 8.
+-- | /O(n)/ @'toByteString' bs@ converts @bs@ into 'L.ByteString',
+-- padding incomplete bytes to single bytes with necessary 0's at
+-- their MSB. Thus the following equation does not hold when the
+-- length of @bs@ isn't multiple of 8.
--
-- > fromByteString . toByteString = id
--
-- But the following always holds true.
--
-- > toByteString . fromByteString = id
+--
+-- Note that @bs@ must have a finite length.
toByteString ∷ BitString → L.ByteString
toByteString bs
= L.concat [ remToStr $ leftRem bs
, L.reverse $ rightBytes bs
, remToStr $ rightRem bs
]
+
+-- | /O(n)/ @'take' n bs@ returns the prefix of @bs@ of length
+-- @n@. @bs@ must have at least @n@ bits.
+take ∷ Integral n ⇒ n → BitString → BitString
+take n xs = case splitAt n xs of
+ (taken, _) → taken
+
+-- | /O(n)/ @'drop' n bs@ returns the suffix of @bs@ after the first
+-- @n@ bits. @bs@ must have at least @n@ bits.
+drop ∷ Integral n ⇒ n → BitString → BitString
+drop n xs = case splitAt n xs of
+ (_, dropped) → dropped
+
+-- | /O(n)/ @'splitAt' n bs@ is equivalent to @('take' n bs, 'drop' n
+-- bs)@.
+splitAt ∷ Integral n ⇒ n → BitString → (BitString, BitString)
+splitAt n bs
+ = case splitRemAt n $ leftRem bs of
+ (# S.Just h, lr' #)
+ -- The leftRem has enough bits.
+ → let !h' = BitString {
+ leftRem = h
+ , leftBytes = L.empty
+ , rightBytes = L.empty
+ , rightRem = remEmpty
+ }
+ in
+ (h', bs { leftRem = lr' })
+
+ (# S.Nothing, _ #)
+ → let !bytesToTake = (n - fromIntegral (remLen $ leftRem bs)) `div` 8
+ !amortised = leftBytes bs `L.append` (L.reverse $ rightBytes bs)
+ -- 0 ≤ bitsToTake < 8 - remLen (leftRem bs)
+ -- ∴ remLen (leftRem bs) + bitsToTake < 8
+ !bitsToTake = n - bytesToTake ⋅ 8 - fromIntegral (remLen $ leftRem bs)
+ in
+ case (# bytesToTake, L.uncons amortised #) of
+ (#_, Just (!w, amor') #)
+ -- There is at least one byte in the byte pool
+ -- (amortised).
+ → let !h1 = leftRem bs
+ (# h2, lr' #)
+ = case splitRemAt bitsToTake $ byteToRem w of
+ (# S.Just h2', lr'' #) → (# h2', lr'' #)
+ (# S.Nothing , _ #) → error "internal error"
+ !h = h1 `appendRem` h2
+ (bytes, lb')
+ = L.splitAt (fromIntegral bytesToTake) amor'
+ in
+ if L.length bytes ≡ fromIntegral bytesToTake then
+ -- The byte pool actuall has at least
+ -- bytesToTake bytes.
+ let !h' = BitString {
+ leftRem = h
+ , leftBytes = bytes
+ , rightBytes = L.empty
+ , rightRem = remEmpty
+ }
+ !bs' = BitString {
+ leftRem = lr'
+ , leftBytes = lb'
+ , rightBytes = L.empty
+ , rightRem = rightRem bs
+ }
+ in
+ (h', bs')
+ else
+ error "splitAt: not enough bits"
+
+ (# 0, Nothing #)
+ -- No bytes are in the byte pool but the
+ -- rightRem may have enough bits.
+ → case splitRemAt bitsToTake $ rightRem bs of
+ (# S.Just h, rr' #)
+ → let !h' = BitString {
+ leftRem = leftRem bs
+ , leftBytes = L.empty
+ , rightBytes = L.empty
+ , rightRem = h
+ }
+ !bs' = BitString {
+ leftRem = remEmpty
+ , leftBytes = L.empty
+ , rightBytes = L.empty
+ , rightRem = rr'
+ }
+ in
+ (h', bs')
+
+ (# S.Nothing, _ #)
+ → error "splitAt: not enough bits"
+
+ (# _, Nothing #)
+ -- No bytes are in the byte pool but more than 8
+ -- bits are requested. The rightRem can't have
+ -- that many bits.
+ → error "splitAt: not enough bits"
projects / wavpack.git / blobdiff