master..153d2b3 · binary-bits

git.iko.soy/binary-bits

on 153d2b3 help sign in

2 files changed+2−81

since splitsnapshots

unifiedsplit

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

Data/Binary/Bits/Internal.hs−21

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

1212

1313module Data.Binary.Bits.Internal

1414 ( make_mask

15− , make_mask#

1615 , mask

17− , mask#

1816 , bit_offset

1917 , byte_offset

2018 , reverseBits

21− , reverseBits#

2219 , FastBits(..)

2320 )

2421where

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

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

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

4340

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

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

46−

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

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

4943mask n v = v .&. make_mask n

5044{-# INLINE mask #-}

5145

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−

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

5747bit_offset :: Int -> Int

5848bit_offset n = make_mask 3 .&. n

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

7565 rec 0 i r = r `fastShiftL` i

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

7767

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−

8968

9069---------------------------------------------------------------------

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

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

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

1−{-# LANGUAGE MagicHash #-}

2−

31-----------------------------------------------------------------------------

42-- |

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

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

2220 -- * Data types

2321 -- ** Bool

2422 , putBool

25− , putBool#

2623

2724 -- ** Words

28− , putWord#

2925 , putWord8

3026 , putWord16

3127 , putWord32

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

5046import Data.ByteString as BS

5147import Data.ByteString.Unsafe as BS

5248

49+import Control.Applicative

5350import Control.Monad (when)

5451import Data.Bits

52+import Data.Monoid

5553import Data.Word

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

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

5854

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

6056

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

6662putBool :: Bool -> BitPut ()

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

6864

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

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

71−putBool# b = putWord# 1# b

72−

7365

7466-- | Generic putWord

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

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

7769

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

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

80−

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

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

8372 where

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

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

122111 | otherwise = s2

123112

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−

171113

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

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