@@ -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 ()