153d2b3...master · binary-bits

git.iko.soy/binary-bits

on master help sign in

Data/Binary/Bits/Internal.hs+21

since splitsnapshots

unifiedsplit

@@ -12,10 +12,13 @@

13module Data.Binary.Bits.Internal

14 ( make_mask

15+ , make_mask#

15 , mask

16 , mask

17+ , mask#

16 , bit_offset

18 , bit_offset

17 , byte_offset

19 , byte_offset

18 , reverseBits

20 , reverseBits

21+ , reverseBits#

19 , FastBits(..)

22 , FastBits(..)

20 )

23 )

21where

24where

@@ -38,11 +41,18 @@ make_mask n = (1 `shiftL` fromIntegral n) - 1

38{-# SPECIALIZE make_mask :: Int -> Word32 #-}

41{-# SPECIALIZE make_mask :: Int -> Word32 #-}

39{-# SPECIALIZE make_mask :: Int -> Word64 #-}

42{-# SPECIALIZE make_mask :: Int -> Word64 #-}

44+make_mask# :: Int# -> Word#

45+make_mask# n = (1## `shiftL#` n) `minusWord#` 1##

46+

41-- | Keep only the n least-significant bits of the given value

47-- | Keep only the n least-significant bits of the given value

42mask :: (Bits a, Num a) => Int -> a -> a

48mask :: (Bits a, Num a) => Int -> a -> a

43mask n v = v .&. make_mask n

49mask n v = v .&. make_mask n

44{-# INLINE mask #-}

50{-# INLINE mask #-}

52+-- | Keep only the n least-significant bits of the given value

53+mask# :: Int# -> Word# -> Word#

54+mask# n v = v `and#` make_mask# n

55+

46-- | Compute bit offset (equivalent to x `mod` 8 but faster)

56-- | Compute bit offset (equivalent to x `mod` 8 but faster)

47bit_offset :: Int -> Int

57bit_offset :: Int -> Int

48bit_offset n = make_mask 3 .&. n

58bit_offset n = make_mask 3 .&. n

@@ -65,6 +75,17 @@ reverseBits n value = rec value n 0

65 rec 0 i r = r `fastShiftL` i

75 rec 0 i r = r `fastShiftL` i

66 rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))

76 rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))

78+reverseBits# :: Int# -> Word# -> Word#

79+reverseBits# n value = rec value n 0##

80+ where

81+ -- rec v i r, where

82+ -- v is orginal value shifted

83+ -- i is the remaining number of bits

84+ -- r is current value

85+ rec 0## 0# r = r

86+ rec 0## i r = r `shiftL#` i

87+ rec v i r = rec (v `shiftRL#` 1#) (i -# 1#) ((r `shiftL#` 1#) `or#` (v `and#` 0x1##))

88+

69---------------------------------------------------------------------

90---------------------------------------------------------------------

70-- Unchecked shifts, from the "binary" package

91-- Unchecked shifts, from the "binary" package

Data/Binary/Bits/Put.hs+60−2

@@ -1,3 +1,5 @@

1+{-# LANGUAGE MagicHash #-}

1-----------------------------------------------------------------------------

3-----------------------------------------------------------------------------

2-- |

4-- |

3-- Module : Data.Binary.Bits.Put

5-- Module : Data.Binary.Bits.Put

@@ -20,8 +22,10 @@ module Data.Binary.Bits.Put

20 -- * Data types

22 -- * Data types

21 -- ** Bool

23 -- ** Bool

22 , putBool

24 , putBool

25+ , putBool#

24 -- ** Words

27 -- ** Words

28+ , putWord#

25 , putWord8

29 , putWord8

26 , putWord16

30 , putWord16

27 , putWord32

31 , putWord32

@@ -46,11 +50,11 @@ import Data.Binary.Bits.Alignment

46import Data.ByteString as BS

50import Data.ByteString as BS

47import Data.ByteString.Unsafe as BS

51import Data.ByteString.Unsafe as BS

49−import Control.Applicative

50import Control.Monad (when)

53import Control.Monad (when)

51import Data.Bits

54import Data.Bits

52−import Data.Monoid

53import Data.Word

55import Data.Word

56+import GHC.Base (Word#, shiftRL#, Int (..), Int#, (-#), (<#), isTrue#, (+#), shiftL#, wordToWord8#, orWord8#)

57+import GHC.Word (Word8(..))

55data BitPut a = BitPut { run :: (S -> PairS a) }

59data BitPut a = BitPut { run :: (S -> PairS a) }

@@ -62,11 +66,18 @@ data S = S !Builder !Word8 !Int !BitOrder

62putBool :: Bool -> BitPut ()

66putBool :: Bool -> BitPut ()

63putBool b = putWord8 1 (if b then 0xff else 0x00)

67putBool b = putWord8 1 (if b then 0xff else 0x00)

69+-- | Put a 1 bit 'Bool'.

70+putBool# :: Word# -> BitPut ()

71+putBool# b = putWord# 1# b

72+

66-- | Generic putWord

74-- | Generic putWord

67putWord :: (Num a, FastBits a, Integral a) => Int -> a -> BitPut ()

75putWord :: (Num a, FastBits a, Integral a) => Int -> a -> BitPut ()

68putWord n w = BitPut $ \s -> PairS () (putWordS n w s)

76putWord n w = BitPut $ \s -> PairS () (putWordS n w s)

78+putWord# :: Int# -> Word# -> BitPut ()

79+putWord# n w = BitPut $ \s -> PairS () (putWordS# n w s)

80+

70putWordS :: (Num a, FastBits a, Integral a) => Int -> a -> S -> S

81putWordS :: (Num a, FastBits a, Integral a) => Int -> a -> S -> S

71putWordS n w s@(S builder b o bo) = s'

82putWordS n w s@(S builder b o bo) = s'

72 where

83 where

@@ -110,6 +121,53 @@ putWordS n w s@(S builder b o bo) = s'

110 | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2

121 | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2

111 | otherwise = s2

122 | otherwise = s2

112

123

124+putWordS# :: Int# -> Word# -> S -> S

125+putWordS# n w s@(S builder (W8# b) (I# o) bo) = s'

126+ where

127+ min# :: Int# -> Int# -> Int#

128+ min# x y | isTrue# (x <# y) = x

129+ min# _ y = y

130+

131+ -- number of bits that will be stored in the current byte

132+ cn = min# (8# -# o) n

133+

134+ -- new state

135+ s' = case n of

136+ 0# -> s

137+ _ -> putWordS# (n -# cn) w' (flush (S builder (W8# b') (I# (o +# cn)) bo))

138+

139+ -- new current byte

140+ b' = wordToWord8# (shl (selectBits w)) `orWord8#` b

141+

142+ -- Word containing the remaining (n-cn) bits to store in its LSB

143+ w' = case bo of

144+ BB -> w

145+ BL -> w `shiftRL#` cn

146+ LL -> w `shiftRL#` cn

147+ LB -> w

148+

149+ -- Select bits to store in the current byte.

150+ -- Put them in the correct order and return them in the least-significant

151+ -- bits of the returned value

152+ selectBits :: Word# -> Word#

153+ selectBits x = case bo of

154+ BB -> mask# cn (x `shiftRL#` (n -# cn))

155+ LB -> reverseBits# cn (mask# cn (x `shiftRL#` (n -# cn)))

156+ LL -> mask# cn x

157+ BL -> reverseBits# cn (mask# cn x)

158+

159+ -- shift left at the correct position

160+ shl :: Word# -> Word#

161+ shl x = case bo of

162+ BB -> x `shiftL#` (8# -# o -# cn)

163+ BL -> x `shiftL#` (8# -# o -# cn)

164+ LL -> x `shiftL#` o

165+ LB -> x `shiftL#` o

166+

167+ flush s2@(S b2 w2 o2 bo2)

168+ | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2

169+ | otherwise = s2

170+

113

171

114-- | Put the @n@ lower bits of a 'Word8'.

172-- | Put the @n@ lower bits of a 'Word8'.

115putWord8 :: Int -> Word8 -> BitPut ()

173putWord8 :: Int -> Word8 -> BitPut ()