git.iko.soy/binary-bits
on master help sign in
Add helper modules
9358c44Sylvain HENRY
Data/Binary/Bits/BitOrder.hsnew file+28
compare with master
unifiedsplit
@@ -0,0 +1,28 @@
1+-----------------------------------------------------------------------------
2+-- |
3+-- Module : Data.Binary.Bits.Get
4+-- Copyright : (c) Lennart Kolmodin 2010-2011
5+-- License : BSD3-style (see LICENSE)
6+--
7+-- Maintainer : kolmodin@gmail.com
8+-- Stability : experimental
9+-- Portability : portable (should run where the package binary runs)
10+
11+module Data.Binary.Bits.BitOrder
12+ ( BitOrder(..)
13+ )
14+where
15+
16+-- | Bit order
17+--
18+-- E.g. two words of 5 bits: ABCDE, VWXYZ
19+-- - BB: ABCDEVWX YZxxxxxx
20+-- - LB: XYZABCDE xxxxxxVW
21+-- - BL: EDCBAZYX WVxxxxxx
22+-- - LL: XWVEDCBA xxxxxxZY
23+data BitOrder
24+ = BB -- ^ Big-endian bytes and bits
25+ | LB -- ^ Little-endian bytes, big-endian bits
26+ | BL -- ^ Big-endian bytes, little-endian bits
27+ | LL -- ^ Little-endian bytes and bits
28+ deriving (Show)
Data/Binary/Bits/Get.hs+5−137
@@ -55,7 +55,6 @@ module Data.Binary.Bits.Get
55 -- $bitget
55 -- $bitget
56
56
57 BitGet
57 BitGet
58− , BitOrder(..)
59 , runBitGet
58 , runBitGet
60 , getBitOrder
59 , getBitOrder
61 , selectBitOrder
60 , selectBitOrder
@@ -99,6 +98,8 @@ module Data.Binary.Bits.Get
99
98
100import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
99import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
101import Data.Binary.Get.Internal as B ( get, put, ensureN )
100import Data.Binary.Get.Internal as B ( get, put, ensureN )
101+import Data.Binary.Bits.BitOrder
102+import Data.Binary.Bits.Internal
102
103
103import Data.ByteString as B
104import Data.ByteString as B
104import qualified Data.ByteString.Lazy as L
105import qualified Data.ByteString.Lazy as L
@@ -115,12 +116,6 @@ import Control.Monad (when,foldM_)
115
116
116import Prelude as P
117import Prelude as P
117
118
118−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
119−import GHC.Base
120−import GHC.Word
121−#endif
122−
123−
124-- $bitget
119-- $bitget
125-- Parse bits using a monad.
120-- Parse bits using a monad.
126--
121--
@@ -172,16 +167,6 @@ data S = S {-# UNPACK #-} !ByteString -- Input
172 !BitOrder -- Bit order
167 !BitOrder -- Bit order
173 deriving (Show)
168 deriving (Show)
174
169
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−
185-- | Increment the current bit offset
170-- | Increment the current bit offset
186incS :: Int -> S -> S
171incS :: Int -> S -> S
187incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
172incS 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
194selectBitOrderS :: BitOrder -> S -> S
179selectBitOrderS :: BitOrder -> S -> S
195selectBitOrderS bo (S bs o _) = S bs o bo
180selectBitOrderS bo (S bs o _) = S bs o bo
196
181
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−
233-- | Read a single bit
182-- | Read a single bit
234readBool :: S -> Bool
183readBool :: S -> Bool
235readBool (S bs o bo) = case bo of
184readBool (S bs o bo) = case bo of
@@ -241,7 +190,7 @@ readBool (S bs o bo) = case bo of
241-- | Extract a range of bits from (ws :: ByteString)
190-- | Extract a range of bits from (ws :: ByteString)
242--
191--
243-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
192-- 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
245extract bo bs o n
194extract bo bs o n
246 | n == 0 = 0
195 | n == 0 = 0
247 | B.length bs == 0 = error "Empty ByteString"
196 | B.length bs == 0 = error "Empty ByteString"
@@ -273,7 +222,7 @@ extract bo bs o n
273
222
274
223
275-- | Generic readWord
224-- | Generic readWord
276−readWord :: (Num a, Bits a, FastBits a) => Int -> S -> a
225+readWord :: (Num a, FastBits a) => Int -> S -> a
277readWord n (S bs o bo)
226readWord n (S bs o bo)
278 | n == 0 = 0
227 | n == 0 = 0
279 | otherwise = extract bo (unsafeTake nbytes bs) o n
228 | otherwise = extract bo (unsafeTake nbytes bs) o n
@@ -281,7 +230,7 @@ readWord n (S bs o bo)
281
230
282-- | Check that the number of bits to read is not greater than the first parameter
231-- | Check that the number of bits to read is not greater than the first parameter
283{-# INLINE readWordChecked #-}
232{-# INLINE readWordChecked #-}
284−readWordChecked :: (Num a, Bits a, FastBits a) => Int -> Int -> S -> a
233+readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
285readWordChecked m n s
234readWordChecked m n s
286 | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
235 | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
287 | otherwise = readWord n s
236 | otherwise = readWord n s
@@ -538,84 +487,3 @@ byteString :: Int -> Block ByteString
538byteString n | n > 0 = Block (n*8) (readByteString n)
487byteString n | n > 0 = Block (n*8) (readByteString n)
539 | otherwise = Block 0 (\_ -> B.empty)
488 | otherwise = Block 0 (\_ -> B.empty)
540
489
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
Data/Binary/Bits/Internal.hsnew file+155
@@ -0,0 +1,155 @@
1+{-# LANGUAGE RankNTypes, MagicHash, BangPatterns, CPP #-}
2+
3+-----------------------------------------------------------------------------
4+-- |
5+-- Module : Data.Binary.Bits.Get
6+-- Copyright : (c) Lennart Kolmodin 2010-2011
7+-- License : BSD3-style (see LICENSE)
8+--
9+-- Maintainer : kolmodin@gmail.com
10+-- Stability : experimental
11+-- Portability : portable (should run where the package binary runs)
12+
13+module Data.Binary.Bits.Internal
14+ ( make_mask
15+ , mask
16+ , bit_offset
17+ , byte_offset
18+ , reverseBits
19+ , FastBits(..)
20+ )
21+where
22+
23+import Data.Word
24+import Data.Bits
25+
26+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
27+import GHC.Base
28+import GHC.Word
29+#endif
30+
31+-- | make_mask 3 = 00000111
32+make_mask :: (FastBits a, Num a) => Int -> a
33+make_mask n = (1 `fastShiftL` fromIntegral n) - 1
34+{-# SPECIALIZE make_mask :: Int -> Int #-}
35+{-# SPECIALIZE make_mask :: Int -> Word #-}
36+{-# SPECIALIZE make_mask :: Int -> Word8 #-}
37+{-# SPECIALIZE make_mask :: Int -> Word16 #-}
38+{-# SPECIALIZE make_mask :: Int -> Word32 #-}
39+{-# SPECIALIZE make_mask :: Int -> Word64 #-}
40+
41+-- | Keep only the n least-significant bits of the given value
42+mask :: (FastBits a, Num a) => Int -> a -> a
43+mask n v = v .&. make_mask n
44+{-# INLINE mask #-}
45+
46+-- | Compute bit offset (equivalent to x `mod` 8 but faster)
47+bit_offset :: Int -> Int
48+bit_offset n = make_mask 3 .&. n
49+{-# INLINE bit_offset #-}
50+
51+-- | Compute byte offset (equivalent to x `div` 8 but faster)
52+byte_offset :: Int -> Int
53+byte_offset n = n `shiftR` 3
54+{-# INLINE byte_offset #-}
55+
56+-- | Reverse the @n@ least important bits of the given value
57+reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a
58+reverseBits n value = rec value n 0
59+ where
60+ -- rec v i r, where
61+ -- v is orginal value shifted
62+ -- i is the remaining number of bits
63+ -- r is current value
64+ rec 0 0 r = r
65+ rec 0 i r = r `fastShiftL` i
66+ rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
67+
68+
69+---------------------------------------------------------------------
70+-- Unchecked shifts, from the "binary" package
71+
72+-- | Class for types supporting fast bit shifting
73+class Bits a => FastBits a where
74+ fastShiftR :: a -> Int -> a
75+ fastShiftR = shiftR
76+
77+ fastShiftL :: a -> Int -> a
78+ fastShiftL = shiftL
79+
80+ {-# INLINE fastShift #-}
81+ fastShift :: a -> Int -> a
82+ fastShift x n
83+ | n > 0 = fastShiftL x n
84+ | n < 0 = fastShiftR x (negate n)
85+ | otherwise = x
86+
87+instance FastBits Word8 where
88+ fastShiftR = shiftr_w8
89+ fastShiftL = shiftl_w8
90+
91+instance FastBits Word16 where
92+ fastShiftR = shiftr_w16
93+ fastShiftL = shiftl_w16
94+
95+instance FastBits Word32 where
96+ fastShiftR = shiftr_w32
97+ fastShiftL = shiftl_w32
98+
99+instance FastBits Word64 where
100+ fastShiftR = shiftr_w64
101+ fastShiftL = shiftl_w64
102+
103+instance FastBits Int
104+
105+instance FastBits Word
106+
107+
108+shiftl_w8 :: Word8 -> Int -> Word8
109+shiftl_w16 :: Word16 -> Int -> Word16
110+shiftl_w32 :: Word32 -> Int -> Word32
111+shiftl_w64 :: Word64 -> Int -> Word64
112+
113+shiftr_w8 :: Word8 -> Int -> Word8
114+shiftr_w16 :: Word16 -> Int -> Word16
115+shiftr_w32 :: Word32 -> Int -> Word32
116+shiftr_w64 :: Word64 -> Int -> Word64
117+
118+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
119+shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
120+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
121+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
122+
123+shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
124+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
125+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
126+
127+
128+#if WORD_SIZE_IN_BITS < 64
129+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
130+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
131+
132+#if __GLASGOW_HASKELL__ <= 606
133+-- Exported by GHC.Word in GHC 6.8 and higher
134+foreign import ccall unsafe "stg_uncheckedShiftL64"
135+ uncheckedShiftL64# :: Word64# -> Int# -> Word64#
136+foreign import ccall unsafe "stg_uncheckedShiftRL64"
137+ uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
138+#endif
139+
140+#else
141+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
142+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
143+#endif
144+
145+#else
146+shiftl_w8 = shiftL
147+shiftl_w16 = shiftL
148+shiftl_w32 = shiftL
149+shiftl_w64 = shiftL
150+
151+shiftr_w8 = shiftR
152+shiftr_w16 = shiftR
153+shiftr_w32 = shiftR
154+shiftr_w64 = shiftR
155+#endif
Data/Binary/Bits/Put.hs+1−9
@@ -35,6 +35,7 @@ import qualified Data.Binary.Builder as B
35import Data.Binary.Builder ( Builder )
35import Data.Binary.Builder ( Builder )
36import qualified Data.Binary.Put as Put
36import qualified Data.Binary.Put as Put
37import Data.Binary.Put ( Put )
37import Data.Binary.Put ( Put )
38+import Data.Binary.Bits.Internal
38
39
39import Data.ByteString
40import Data.ByteString
40
41
@@ -53,15 +54,6 @@ data S = S !Builder !Word8 !Int
53putBool :: Bool -> BitPut ()
54putBool :: Bool -> BitPut ()
54putBool b = putWord8 1 (if b then 0xff else 0x00)
55putBool b = putWord8 1 (if b then 0xff else 0x00)
55
56
56−-- | make_mask 3 = 00000111
57−make_mask :: (Bits a, Num a) => Int -> a
58−make_mask n = (1 `shiftL` fromIntegral n) - 1
59−{-# SPECIALIZE make_mask :: Int -> Int #-}
60−{-# SPECIALIZE make_mask :: Int -> Word #-}
61−{-# SPECIALIZE make_mask :: Int -> Word8 #-}
62−{-# SPECIALIZE make_mask :: Int -> Word16 #-}
63−{-# SPECIALIZE make_mask :: Int -> Word32 #-}
64−{-# SPECIALIZE make_mask :: Int -> Word64 #-}
65
57
66-- | Put the @n@ lower bits of a 'Word8'.
58-- | Put the @n@ lower bits of a 'Word8'.
67putWord8 :: Int -> Word8 -> BitPut ()
59putWord8 :: Int -> Word8 -> BitPut ()
binary-bits.cabal+3−1
@@ -24,7 +24,9 @@ library
24
24
25 exposed-modules: Data.Binary.Bits ,
25 exposed-modules: Data.Binary.Bits ,
26 Data.Binary.Bits.Put ,
26 Data.Binary.Bits.Put ,
27− Data.Binary.Bits.Get
27+ Data.Binary.Bits.Get ,
28+ Data.Binary.Bits.BitOrder
29+ other-modules: Data.Binary.Bits.Internal
28
30
29 default-language: Haskell98
31 default-language: Haskell98
30
32