@@ -55,7 +55,6 @@ module Data.Binary.Bits.Get
5555 -- $bitget
5656
5757 BitGet
58− , BitOrder(..)
5958 , runBitGet
6059 , getBitOrder
6160 , selectBitOrder
@@ -99,6 +98,8 @@ module Data.Binary.Bits.Get
9998
10099import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
101100import Data.Binary.Get.Internal as B ( get, put, ensureN )
101+import Data.Binary.Bits.BitOrder
102+import Data.Binary.Bits.Internal
102103
103104import Data.ByteString as B
104105import qualified Data.ByteString.Lazy as L
@@ -115,12 +116,6 @@ import Control.Monad (when,foldM_)
115116
116117import Prelude as P
117118
118−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
119−import GHC.Base
120−import GHC.Word
121−#endif
122−
123−
124119-- $bitget
125120-- Parse bits using a monad.
126121--
@@ -172,16 +167,6 @@ data S = S {-# UNPACK #-} !ByteString -- Input
172167 !BitOrder -- Bit order
173168 deriving (Show)
174169
175−-- | Compute bit offset (equivalent to x `mod` 8 but faster)
176−bit_offset :: Int -> Int
177−bit_offset n = make_mask 3 .&. n
178−{-# INLINE bit_offset #-}
179−
180−-- | Compute byte offset (equivalent to x `div` 8 but faster)
181−byte_offset :: Int -> Int
182−byte_offset n = n `shiftR` 3
183−{-# INLINE byte_offset #-}
184−
185170-- | Increment the current bit offset
186171incS :: Int -> S -> S
187172incS 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
194179selectBitOrderS :: BitOrder -> S -> S
195180selectBitOrderS bo (S bs o _) = S bs o bo
196181
197−-- | make_mask 3 = 00000111
198−make_mask :: (Bits a, Num a) => Int -> a
199−make_mask n = (1 `shiftL` fromIntegral n) - 1
200−{-# SPECIALIZE make_mask :: Int -> Int #-}
201−{-# SPECIALIZE make_mask :: Int -> Word #-}
202−{-# SPECIALIZE make_mask :: Int -> Word8 #-}
203−{-# SPECIALIZE make_mask :: Int -> Word16 #-}
204−{-# SPECIALIZE make_mask :: Int -> Word32 #-}
205−{-# SPECIALIZE make_mask :: Int -> Word64 #-}
206−
207−-- | Keep only the n least-significant bits of the given value
208−mask :: (Bits a, Num a) => Int -> a -> a
209−mask n v = v .&. make_mask n
210−{-# INLINE mask #-}
211−
212−-- | Bit order
213−--
214−-- E.g. two words of 5 bits: ABCDE, VWXYZ
215−-- - BB: ABCDEVWX YZxxxxxx
216−-- - LB: XYZABCDE xxxxxxVW
217−-- - BL: EDCBAZYX WVxxxxxx
218−-- - LL: XWVEDCBA xxxxxxZY
219−data BitOrder = BB | LB | BL | LL deriving (Show)
220−
221−-- | Reverse the @n@ least important bits of the given value
222−reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a
223−reverseBits n value = rec value n 0
224− where
225− -- rec v i r, where
226− -- v is orginal value shifted
227− -- i is the remaining number of bits
228− -- r is current value
229− rec 0 0 r = r
230− rec 0 i r = r `fastShiftL` i
231− rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
232−
233182-- | Read a single bit
234183readBool :: S -> Bool
235184readBool (S bs o bo) = case bo of
@@ -241,7 +190,7 @@ readBool (S bs o bo) = case bo of
241190-- | Extract a range of bits from (ws :: ByteString)
242191--
243192-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
244−extract :: (Num a, Bits a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
193+extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
245194extract bo bs o n
246195 | n == 0 = 0
247196 | B.length bs == 0 = error "Empty ByteString"
@@ -273,7 +222,7 @@ extract bo bs o n
273222
274223
275224-- | Generic readWord
276−readWord :: (Num a, Bits a, FastBits a) => Int -> S -> a
225+readWord :: (Num a, FastBits a) => Int -> S -> a
277226readWord n (S bs o bo)
278227 | n == 0 = 0
279228 | otherwise = extract bo (unsafeTake nbytes bs) o n
@@ -281,7 +230,7 @@ readWord n (S bs o bo)
281230
282231-- | Check that the number of bits to read is not greater than the first parameter
283232{-# INLINE readWordChecked #-}
284−readWordChecked :: (Num a, Bits a, FastBits a) => Int -> Int -> S -> a
233+readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
285234readWordChecked m n s
286235 | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
287236 | otherwise = readWord n s
@@ -538,84 +487,3 @@ byteString :: Int -> Block ByteString
538487byteString n | n > 0 = Block (n*8) (readByteString n)
539488 | otherwise = Block 0 (\_ -> B.empty)
540489
541−
542−---------------------------------------------------------------------
543−-- Unchecked shifts, from the "binary" package
544−
545−-- | Class for types supporting fast bit shifting
546−class FastBits a where
547− fastShiftR :: a -> Int -> a
548− fastShiftL :: a -> Int -> a
549−
550− {-# INLINE fastShift #-}
551− fastShift :: a -> Int -> a
552− fastShift x n
553− | n > 0 = fastShiftL x n
554− | n < 0 = fastShiftR x (negate n)
555− | otherwise = x
556−
557−instance FastBits Word8 where
558− fastShiftR = shiftr_w8
559− fastShiftL = shiftl_w8
560−
561−instance FastBits Word16 where
562− fastShiftR = shiftr_w16
563− fastShiftL = shiftl_w16
564−
565−instance FastBits Word32 where
566− fastShiftR = shiftr_w32
567− fastShiftL = shiftl_w32
568−
569−instance FastBits Word64 where
570− fastShiftR = shiftr_w64
571− fastShiftL = shiftl_w64
572−
573−
574−shiftl_w8 :: Word8 -> Int -> Word8
575−shiftl_w16 :: Word16 -> Int -> Word16
576−shiftl_w32 :: Word32 -> Int -> Word32
577−shiftl_w64 :: Word64 -> Int -> Word64
578−
579−shiftr_w8 :: Word8 -> Int -> Word8
580−shiftr_w16 :: Word16 -> Int -> Word16
581−shiftr_w32 :: Word32 -> Int -> Word32
582−shiftr_w64 :: Word64 -> Int -> Word64
583−
584−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
585−shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
586−shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
587−shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
588−
589−shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
590−shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
591−shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
592−
593−
594−#if WORD_SIZE_IN_BITS < 64
595−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
596−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
597−
598−#if __GLASGOW_HASKELL__ <= 606
599−-- Exported by GHC.Word in GHC 6.8 and higher
600−foreign import ccall unsafe "stg_uncheckedShiftL64"
601− uncheckedShiftL64# :: Word64# -> Int# -> Word64#
602−foreign import ccall unsafe "stg_uncheckedShiftRL64"
603− uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
604−#endif
605−
606−#else
607−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
608−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
609−#endif
610−
611−#else
612−shiftl_w8 = shiftL
613−shiftl_w16 = shiftL
614−shiftl_w32 = shiftL
615−shiftl_w64 = shiftL
616−
617−shiftr_w8 = shiftR
618−shiftr_w16 = shiftR
619−shiftr_w32 = shiftR
620−shiftr_w64 = shiftR
621−#endif