git.iko.soy/binary-bits
on master help sign in
swap
21adca71 ahead, 0 behind
2 files changed+81−2
since splitsnapshots
unifiedsplit
Data/Binary/Bits/Internal.hs+21 Data/Binary/Bits/Put.hs+60−2
Data/Binary/Bits/Internal.hs+21
@@ -12,10 +12,13 @@
1212
1313module Data.Binary.Bits.Internal
1414 ( make_mask
15+ , make_mask#
1516 , mask
17+ , mask#
1618 , bit_offset
1719 , byte_offset
1820 , reverseBits
21+ , reverseBits#
1922 , FastBits(..)
2023 )
2124where
@@ -38,11 +41,18 @@ make_mask n = (1 `shiftL` fromIntegral n) - 1
3841{-# SPECIALIZE make_mask :: Int -> Word32 #-}
3942{-# SPECIALIZE make_mask :: Int -> Word64 #-}
4043
44+make_mask# :: Int# -> Word#
45+make_mask# n = (1## `shiftL#` n) `minusWord#` 1##
46+
4147-- | Keep only the n least-significant bits of the given value
4248mask :: (Bits a, Num a) => Int -> a -> a
4349mask n v = v .&. make_mask n
4450{-# INLINE mask #-}
4551
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+
4656-- | Compute bit offset (equivalent to x `mod` 8 but faster)
4757bit_offset :: Int -> Int
4858bit_offset n = make_mask 3 .&. n
@@ -65,6 +75,17 @@ reverseBits n value = rec value n 0
6575 rec 0 i r = r `fastShiftL` i
6676 rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
6777
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+
6889
6990---------------------------------------------------------------------
7091-- Unchecked shifts, from the "binary" package
Data/Binary/Bits/Put.hs+60−2
@@ -1,3 +1,5 @@
1+{-# LANGUAGE MagicHash #-}
2+
13-----------------------------------------------------------------------------
24-- |
35-- Module : Data.Binary.Bits.Put
@@ -20,8 +22,10 @@ module Data.Binary.Bits.Put
2022 -- * Data types
2123 -- ** Bool
2224 , putBool
25+ , putBool#
2326
2427 -- ** Words
28+ , putWord#
2529 , putWord8
2630 , putWord16
2731 , putWord32
@@ -46,11 +50,11 @@ import Data.Binary.Bits.Alignment
4650import Data.ByteString as BS
4751import Data.ByteString.Unsafe as BS
4852
49−import Control.Applicative
5053import Control.Monad (when)
5154import Data.Bits
52−import Data.Monoid
5355import Data.Word
56+import GHC.Base (Word#, shiftRL#, Int (..), Int#, (-#), (<#), isTrue#, (+#), shiftL#, wordToWord8#, orWord8#)
57+import GHC.Word (Word8(..))
5458
5559data BitPut a = BitPut { run :: (S -> PairS a) }
5660
@@ -62,11 +66,18 @@ data S = S !Builder !Word8 !Int !BitOrder
6266putBool :: Bool -> BitPut ()
6367putBool b = putWord8 1 (if b then 0xff else 0x00)
6468
69+-- | Put a 1 bit 'Bool'.
70+putBool# :: Word# -> BitPut ()
71+putBool# b = putWord# 1# b
72+
6573
6674-- | Generic putWord
6775putWord :: (Num a, FastBits a, Integral a) => Int -> a -> BitPut ()
6876putWord n w = BitPut $ \s -> PairS () (putWordS n w s)
6977
78+putWord# :: Int# -> Word# -> BitPut ()
79+putWord# n w = BitPut $ \s -> PairS () (putWordS# n w s)
80+
7081putWordS :: (Num a, FastBits a, Integral a) => Int -> a -> S -> S
7182putWordS n w s@(S builder b o bo) = s'
7283 where
@@ -110,6 +121,53 @@ putWordS n w s@(S builder b o bo) = s'
110121 | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2
111122 | otherwise = s2
112123
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+
113171
114172-- | Put the @n@ lower bits of a 'Word8'.
115173putWord8 :: Int -> Word8 -> BitPut ()