mirror of
https://github.com/ilyakooo0/binary-bits.git
synced 2024-09-11 06:35:26 +03:00
Add helper modules
This commit is contained in:
parent
c64ffc682c
commit
9358c44428
28
Data/Binary/Bits/BitOrder.hs
Normal file
28
Data/Binary/Bits/BitOrder.hs
Normal file
@ -0,0 +1,28 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Data.Binary.Bits.Get
|
||||
-- Copyright : (c) Lennart Kolmodin 2010-2011
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : kolmodin@gmail.com
|
||||
-- Stability : experimental
|
||||
-- Portability : portable (should run where the package binary runs)
|
||||
|
||||
module Data.Binary.Bits.BitOrder
|
||||
( BitOrder(..)
|
||||
)
|
||||
where
|
||||
|
||||
-- | Bit order
|
||||
--
|
||||
-- E.g. two words of 5 bits: ABCDE, VWXYZ
|
||||
-- - BB: ABCDEVWX YZxxxxxx
|
||||
-- - LB: XYZABCDE xxxxxxVW
|
||||
-- - BL: EDCBAZYX WVxxxxxx
|
||||
-- - LL: XWVEDCBA xxxxxxZY
|
||||
data BitOrder
|
||||
= BB -- ^ Big-endian bytes and bits
|
||||
| LB -- ^ Little-endian bytes, big-endian bits
|
||||
| BL -- ^ Big-endian bytes, little-endian bits
|
||||
| LL -- ^ Little-endian bytes and bits
|
||||
deriving (Show)
|
@ -55,7 +55,6 @@ module Data.Binary.Bits.Get
|
||||
-- $bitget
|
||||
|
||||
BitGet
|
||||
, BitOrder(..)
|
||||
, runBitGet
|
||||
, getBitOrder
|
||||
, selectBitOrder
|
||||
@ -99,6 +98,8 @@ module Data.Binary.Bits.Get
|
||||
|
||||
import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
|
||||
import Data.Binary.Get.Internal as B ( get, put, ensureN )
|
||||
import Data.Binary.Bits.BitOrder
|
||||
import Data.Binary.Bits.Internal
|
||||
|
||||
import Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
@ -115,12 +116,6 @@ import Control.Monad (when,foldM_)
|
||||
|
||||
import Prelude as P
|
||||
|
||||
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
|
||||
import GHC.Base
|
||||
import GHC.Word
|
||||
#endif
|
||||
|
||||
|
||||
-- $bitget
|
||||
-- Parse bits using a monad.
|
||||
--
|
||||
@ -172,16 +167,6 @@ data S = S {-# UNPACK #-} !ByteString -- Input
|
||||
!BitOrder -- Bit order
|
||||
deriving (Show)
|
||||
|
||||
-- | Compute bit offset (equivalent to x `mod` 8 but faster)
|
||||
bit_offset :: Int -> Int
|
||||
bit_offset n = make_mask 3 .&. n
|
||||
{-# INLINE bit_offset #-}
|
||||
|
||||
-- | Compute byte offset (equivalent to x `div` 8 but faster)
|
||||
byte_offset :: Int -> Int
|
||||
byte_offset n = n `shiftR` 3
|
||||
{-# INLINE byte_offset #-}
|
||||
|
||||
-- | Increment the current bit offset
|
||||
incS :: Int -> S -> S
|
||||
incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
|
||||
@ -194,42 +179,6 @@ incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
|
||||
selectBitOrderS :: BitOrder -> S -> S
|
||||
selectBitOrderS bo (S bs o _) = S bs o bo
|
||||
|
||||
-- | make_mask 3 = 00000111
|
||||
make_mask :: (Bits a, Num a) => Int -> a
|
||||
make_mask n = (1 `shiftL` fromIntegral n) - 1
|
||||
{-# SPECIALIZE make_mask :: Int -> Int #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word8 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word16 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word32 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word64 #-}
|
||||
|
||||
-- | Keep only the n least-significant bits of the given value
|
||||
mask :: (Bits a, Num a) => Int -> a -> a
|
||||
mask n v = v .&. make_mask n
|
||||
{-# INLINE mask #-}
|
||||
|
||||
-- | Bit order
|
||||
--
|
||||
-- E.g. two words of 5 bits: ABCDE, VWXYZ
|
||||
-- - BB: ABCDEVWX YZxxxxxx
|
||||
-- - LB: XYZABCDE xxxxxxVW
|
||||
-- - BL: EDCBAZYX WVxxxxxx
|
||||
-- - LL: XWVEDCBA xxxxxxZY
|
||||
data BitOrder = BB | LB | BL | LL deriving (Show)
|
||||
|
||||
-- | Reverse the @n@ least important bits of the given value
|
||||
reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a
|
||||
reverseBits n value = rec value n 0
|
||||
where
|
||||
-- rec v i r, where
|
||||
-- v is orginal value shifted
|
||||
-- i is the remaining number of bits
|
||||
-- r is current value
|
||||
rec 0 0 r = r
|
||||
rec 0 i r = r `fastShiftL` i
|
||||
rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
|
||||
|
||||
-- | Read a single bit
|
||||
readBool :: S -> Bool
|
||||
readBool (S bs o bo) = case bo of
|
||||
@ -241,7 +190,7 @@ readBool (S bs o bo) = case bo of
|
||||
-- | Extract a range of bits from (ws :: ByteString)
|
||||
--
|
||||
-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
|
||||
extract :: (Num a, Bits a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
|
||||
extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
|
||||
extract bo bs o n
|
||||
| n == 0 = 0
|
||||
| B.length bs == 0 = error "Empty ByteString"
|
||||
@ -273,7 +222,7 @@ extract bo bs o n
|
||||
|
||||
|
||||
-- | Generic readWord
|
||||
readWord :: (Num a, Bits a, FastBits a) => Int -> S -> a
|
||||
readWord :: (Num a, FastBits a) => Int -> S -> a
|
||||
readWord n (S bs o bo)
|
||||
| n == 0 = 0
|
||||
| otherwise = extract bo (unsafeTake nbytes bs) o n
|
||||
@ -281,7 +230,7 @@ readWord n (S bs o bo)
|
||||
|
||||
-- | Check that the number of bits to read is not greater than the first parameter
|
||||
{-# INLINE readWordChecked #-}
|
||||
readWordChecked :: (Num a, Bits a, FastBits a) => Int -> Int -> S -> a
|
||||
readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
|
||||
readWordChecked m n s
|
||||
| n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
|
||||
| otherwise = readWord n s
|
||||
@ -538,84 +487,3 @@ byteString :: Int -> Block ByteString
|
||||
byteString n | n > 0 = Block (n*8) (readByteString n)
|
||||
| otherwise = Block 0 (\_ -> B.empty)
|
||||
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- Unchecked shifts, from the "binary" package
|
||||
|
||||
-- | Class for types supporting fast bit shifting
|
||||
class FastBits a where
|
||||
fastShiftR :: a -> Int -> a
|
||||
fastShiftL :: a -> Int -> a
|
||||
|
||||
{-# INLINE fastShift #-}
|
||||
fastShift :: a -> Int -> a
|
||||
fastShift x n
|
||||
| n > 0 = fastShiftL x n
|
||||
| n < 0 = fastShiftR x (negate n)
|
||||
| otherwise = x
|
||||
|
||||
instance FastBits Word8 where
|
||||
fastShiftR = shiftr_w8
|
||||
fastShiftL = shiftl_w8
|
||||
|
||||
instance FastBits Word16 where
|
||||
fastShiftR = shiftr_w16
|
||||
fastShiftL = shiftl_w16
|
||||
|
||||
instance FastBits Word32 where
|
||||
fastShiftR = shiftr_w32
|
||||
fastShiftL = shiftl_w32
|
||||
|
||||
instance FastBits Word64 where
|
||||
fastShiftR = shiftr_w64
|
||||
fastShiftL = shiftl_w64
|
||||
|
||||
|
||||
shiftl_w8 :: Word8 -> Int -> Word8
|
||||
shiftl_w16 :: Word16 -> Int -> Word16
|
||||
shiftl_w32 :: Word32 -> Int -> Word32
|
||||
shiftl_w64 :: Word64 -> Int -> Word64
|
||||
|
||||
shiftr_w8 :: Word8 -> Int -> Word8
|
||||
shiftr_w16 :: Word16 -> Int -> Word16
|
||||
shiftr_w32 :: Word32 -> Int -> Word32
|
||||
shiftr_w64 :: Word64 -> Int -> Word64
|
||||
|
||||
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
|
||||
shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
|
||||
shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
|
||||
shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
|
||||
|
||||
shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
|
||||
shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
|
||||
shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
|
||||
|
||||
|
||||
#if WORD_SIZE_IN_BITS < 64
|
||||
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
|
||||
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
|
||||
|
||||
#if __GLASGOW_HASKELL__ <= 606
|
||||
-- Exported by GHC.Word in GHC 6.8 and higher
|
||||
foreign import ccall unsafe "stg_uncheckedShiftL64"
|
||||
uncheckedShiftL64# :: Word64# -> Int# -> Word64#
|
||||
foreign import ccall unsafe "stg_uncheckedShiftRL64"
|
||||
uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
|
||||
#endif
|
||||
|
||||
#else
|
||||
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
|
||||
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
|
||||
#endif
|
||||
|
||||
#else
|
||||
shiftl_w8 = shiftL
|
||||
shiftl_w16 = shiftL
|
||||
shiftl_w32 = shiftL
|
||||
shiftl_w64 = shiftL
|
||||
|
||||
shiftr_w8 = shiftR
|
||||
shiftr_w16 = shiftR
|
||||
shiftr_w32 = shiftR
|
||||
shiftr_w64 = shiftR
|
||||
#endif
|
||||
|
155
Data/Binary/Bits/Internal.hs
Normal file
155
Data/Binary/Bits/Internal.hs
Normal file
@ -0,0 +1,155 @@
|
||||
{-# LANGUAGE RankNTypes, MagicHash, BangPatterns, CPP #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Data.Binary.Bits.Get
|
||||
-- Copyright : (c) Lennart Kolmodin 2010-2011
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : kolmodin@gmail.com
|
||||
-- Stability : experimental
|
||||
-- Portability : portable (should run where the package binary runs)
|
||||
|
||||
module Data.Binary.Bits.Internal
|
||||
( make_mask
|
||||
, mask
|
||||
, bit_offset
|
||||
, byte_offset
|
||||
, reverseBits
|
||||
, FastBits(..)
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
|
||||
import GHC.Base
|
||||
import GHC.Word
|
||||
#endif
|
||||
|
||||
-- | make_mask 3 = 00000111
|
||||
make_mask :: (FastBits a, Num a) => Int -> a
|
||||
make_mask n = (1 `fastShiftL` fromIntegral n) - 1
|
||||
{-# SPECIALIZE make_mask :: Int -> Int #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word8 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word16 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word32 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word64 #-}
|
||||
|
||||
-- | Keep only the n least-significant bits of the given value
|
||||
mask :: (FastBits a, Num a) => Int -> a -> a
|
||||
mask n v = v .&. make_mask n
|
||||
{-# INLINE mask #-}
|
||||
|
||||
-- | Compute bit offset (equivalent to x `mod` 8 but faster)
|
||||
bit_offset :: Int -> Int
|
||||
bit_offset n = make_mask 3 .&. n
|
||||
{-# INLINE bit_offset #-}
|
||||
|
||||
-- | Compute byte offset (equivalent to x `div` 8 but faster)
|
||||
byte_offset :: Int -> Int
|
||||
byte_offset n = n `shiftR` 3
|
||||
{-# INLINE byte_offset #-}
|
||||
|
||||
-- | Reverse the @n@ least important bits of the given value
|
||||
reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a
|
||||
reverseBits n value = rec value n 0
|
||||
where
|
||||
-- rec v i r, where
|
||||
-- v is orginal value shifted
|
||||
-- i is the remaining number of bits
|
||||
-- r is current value
|
||||
rec 0 0 r = r
|
||||
rec 0 i r = r `fastShiftL` i
|
||||
rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
|
||||
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- Unchecked shifts, from the "binary" package
|
||||
|
||||
-- | Class for types supporting fast bit shifting
|
||||
class Bits a => FastBits a where
|
||||
fastShiftR :: a -> Int -> a
|
||||
fastShiftR = shiftR
|
||||
|
||||
fastShiftL :: a -> Int -> a
|
||||
fastShiftL = shiftL
|
||||
|
||||
{-# INLINE fastShift #-}
|
||||
fastShift :: a -> Int -> a
|
||||
fastShift x n
|
||||
| n > 0 = fastShiftL x n
|
||||
| n < 0 = fastShiftR x (negate n)
|
||||
| otherwise = x
|
||||
|
||||
instance FastBits Word8 where
|
||||
fastShiftR = shiftr_w8
|
||||
fastShiftL = shiftl_w8
|
||||
|
||||
instance FastBits Word16 where
|
||||
fastShiftR = shiftr_w16
|
||||
fastShiftL = shiftl_w16
|
||||
|
||||
instance FastBits Word32 where
|
||||
fastShiftR = shiftr_w32
|
||||
fastShiftL = shiftl_w32
|
||||
|
||||
instance FastBits Word64 where
|
||||
fastShiftR = shiftr_w64
|
||||
fastShiftL = shiftl_w64
|
||||
|
||||
instance FastBits Int
|
||||
|
||||
instance FastBits Word
|
||||
|
||||
|
||||
shiftl_w8 :: Word8 -> Int -> Word8
|
||||
shiftl_w16 :: Word16 -> Int -> Word16
|
||||
shiftl_w32 :: Word32 -> Int -> Word32
|
||||
shiftl_w64 :: Word64 -> Int -> Word64
|
||||
|
||||
shiftr_w8 :: Word8 -> Int -> Word8
|
||||
shiftr_w16 :: Word16 -> Int -> Word16
|
||||
shiftr_w32 :: Word32 -> Int -> Word32
|
||||
shiftr_w64 :: Word64 -> Int -> Word64
|
||||
|
||||
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
|
||||
shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
|
||||
shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
|
||||
shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
|
||||
|
||||
shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
|
||||
shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
|
||||
shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
|
||||
|
||||
|
||||
#if WORD_SIZE_IN_BITS < 64
|
||||
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
|
||||
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
|
||||
|
||||
#if __GLASGOW_HASKELL__ <= 606
|
||||
-- Exported by GHC.Word in GHC 6.8 and higher
|
||||
foreign import ccall unsafe "stg_uncheckedShiftL64"
|
||||
uncheckedShiftL64# :: Word64# -> Int# -> Word64#
|
||||
foreign import ccall unsafe "stg_uncheckedShiftRL64"
|
||||
uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
|
||||
#endif
|
||||
|
||||
#else
|
||||
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
|
||||
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
|
||||
#endif
|
||||
|
||||
#else
|
||||
shiftl_w8 = shiftL
|
||||
shiftl_w16 = shiftL
|
||||
shiftl_w32 = shiftL
|
||||
shiftl_w64 = shiftL
|
||||
|
||||
shiftr_w8 = shiftR
|
||||
shiftr_w16 = shiftR
|
||||
shiftr_w32 = shiftR
|
||||
shiftr_w64 = shiftR
|
||||
#endif
|
@ -35,6 +35,7 @@ import qualified Data.Binary.Builder as B
|
||||
import Data.Binary.Builder ( Builder )
|
||||
import qualified Data.Binary.Put as Put
|
||||
import Data.Binary.Put ( Put )
|
||||
import Data.Binary.Bits.Internal
|
||||
|
||||
import Data.ByteString
|
||||
|
||||
@ -53,15 +54,6 @@ data S = S !Builder !Word8 !Int
|
||||
putBool :: Bool -> BitPut ()
|
||||
putBool b = putWord8 1 (if b then 0xff else 0x00)
|
||||
|
||||
-- | make_mask 3 = 00000111
|
||||
make_mask :: (Bits a, Num a) => Int -> a
|
||||
make_mask n = (1 `shiftL` fromIntegral n) - 1
|
||||
{-# SPECIALIZE make_mask :: Int -> Int #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word8 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word16 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word32 #-}
|
||||
{-# SPECIALIZE make_mask :: Int -> Word64 #-}
|
||||
|
||||
-- | Put the @n@ lower bits of a 'Word8'.
|
||||
putWord8 :: Int -> Word8 -> BitPut ()
|
||||
|
@ -24,7 +24,9 @@ library
|
||||
|
||||
exposed-modules: Data.Binary.Bits ,
|
||||
Data.Binary.Bits.Put ,
|
||||
Data.Binary.Bits.Get
|
||||
Data.Binary.Bits.Get ,
|
||||
Data.Binary.Bits.BitOrder
|
||||
other-modules: Data.Binary.Bits.Internal
|
||||
|
||||
default-language: Haskell98
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user