on master help sign in
Enable get/putWord64be, add BinaryBit instance, enable tests
commit7a56f9ef5d02622df1b8f718f010c66d99ba75e9 authorLennart Kolmodin <kolmodin@gentoo.org> dateFri 27 Aug 2010, 18:20 (16 years ago) parent70687bc
4 files changed+19−14
Bits.hs−2 BitsGet.hs+9−5 BitsPut.hs+3 BitsQC.hs+7−7
Bits.hs−2
@@ -25,8 +25,6 @@ instance BinaryBit Word32 where
2525 putBits = putWord32be
2626 getBits = getWord32be
2727
28−{-
2928instance BinaryBit Word64 where
3029 putBits = putWord64be
3130 getBits = getWord64be
32−-}
BitsGet.hs+9−5
@@ -11,6 +11,7 @@ module BitsGet
1111 , getWord8
1212 , getWord16be
1313 , getWord32be
14+ , getWord64be
1415
1516 , readBool
1617 , readWord8
@@ -199,7 +200,7 @@ readWord32be s@(S bs o) n
199200 | otherwise = error "readWord32be: tried to read more than 32 bits"
200201
201202
202−readWord64be :: S -> Int -> T Word32 S
203+readWord64be :: S -> Int -> T Word64 S
203204readWord64be s@(S bs o) n
204205 -- 8 or fewer bits, use readWord8
205206 | n <= 8 = let w :*: s' = readWord8 s n
@@ -209,9 +210,9 @@ readWord64be s@(S bs o) n
209210 | n <= 16 = let w :*: s' = readWord16be s n
210211 in fromIntegral w :*: s'
211212
212− | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
213+ | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
213214
214− | n <= 64 = readWithOffset s shiftl_w32 shiftr_w32 n
215+ | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
215216
216217 | otherwise = error "readWord64be: tried to read more than 64 bits"
217218
@@ -273,13 +274,16 @@ getBool = ensure 1 >> modifyState readBool
273274
274275getWord8 :: Int -> BitGet Word8
275276getWord8 n = ensure n >> modifyState (flip readWord8 n)
276−
277+
277278getWord16be :: Int -> BitGet Word16
278279getWord16be n = ensure n >> modifyState (flip readWord16be n)
279280
280281getWord32be :: Int -> BitGet Word32
281282getWord32be n = ensure n >> modifyState (flip readWord32be n)
282−
283+
284+getWord64be :: Int -> BitGet Word64
285+getWord64be n = ensure n >> modifyState (flip readWord64be n)
286+
283287getState :: BitGet S
284288getState = C $ \s kf ks -> ks s s
285289
BitsPut.hs+3
@@ -28,6 +28,9 @@ data PairS a = PairS a {-# UNPACK #-} !S
2828
2929data S = S !Builder !Word8 !Int
3030
31+instance Show S where
32+ show (S _ w o) = "S( " ++ show w ++ " : " ++ show o ++ ")"
33+
3134putBool :: Bool -> BitPut ()
3235putBool b = putWord8 1 (if b then 1 else 0)
3336
BitsQC.hs+7−7
@@ -51,35 +51,35 @@ tests =
5151 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: [Word8] -> Property)
5252 , testProperty "Word16" (prop_bitput_with_get_from_binary :: [Word16] -> Property)
5353 , testProperty "Word32" (prop_bitput_with_get_from_binary :: [Word32] -> Property)
54− -- , testProperty "Word64" (prop_bitput_with_get_from_binary :: [Word64] -> Property)
54+ , testProperty "Word64" (prop_bitput_with_get_from_binary :: [Word64] -> Property)
5555 ]
5656
5757 , testGroup "prop_bitget_with_put_from_binary"
5858 [ testProperty "Word8" (prop_bitget_with_put_from_binary :: [Word8] -> Property)
5959 , testProperty "Word16" (prop_bitget_with_put_from_binary :: [Word16] -> Property)
6060 , testProperty "Word32" (prop_bitget_with_put_from_binary :: [Word32] -> Property)
61− -- , testProperty "Word64" (prop_bitget_with_put_from_binary :: [Word64] -> Property)
61+ , testProperty "Word64" (prop_bitget_with_put_from_binary :: [Word64] -> Property)
6262 ]
6363
6464 , testGroup "prop_compare_put_with_naive"
6565 [ testProperty "Word8" (prop_compare_put_with_naive :: [Word8] -> Property)
6666 , testProperty "Word16" (prop_compare_put_with_naive :: [Word16] -> Property)
6767 , testProperty "Word32" (prop_compare_put_with_naive :: [Word32] -> Property)
68− -- , testProperty "Word64" (prop_compare_put_with_naive :: [Word64] -> Property)
68+ , testProperty "Word64" (prop_compare_put_with_naive :: [Word64] -> Property)
6969 ]
7070
7171 , testGroup "prop_compare_get_with_naive"
7272 [ testProperty "Word8" (prop_compare_get_with_naive:: [Word8] -> Property)
7373 , testProperty "Word16" (prop_compare_get_with_naive:: [Word16] -> Property)
7474 , testProperty "Word32" (prop_compare_get_with_naive:: [Word32] -> Property)
75− -- , testProperty "Word64" (prop_compare_get_with_naive:: [Word64] -> Property)
75+ , testProperty "Word64" (prop_compare_get_with_naive:: [Word64] -> Property)
7676 ]
7777
7878 , testGroup "prop_put_with_bitreq"
7979 [ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)
8080 , testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)
8181 , testProperty "Word32" (prop_putget_with_bitreq :: Word32 -> Property)
82− -- , testProperty "Word64" (prop_putget_with_bitreq :: Word64 -> Property)
82+ , testProperty "Word64" (prop_putget_with_bitreq :: Word64 -> Property)
8383 ]
8484
8585 , testGroup "prop_putget_list_simple"
@@ -87,14 +87,14 @@ tests =
8787 , testProperty "Word8" (prop_putget_list_simple :: [Word8] -> Property)
8888 , testProperty "Word16" (prop_putget_list_simple :: [Word16] -> Property)
8989 , testProperty "Word32" (prop_putget_list_simple :: [Word32] -> Property)
90− -- , testProperty "Word64" (prop_putget_list_simple :: [Word64] -> Property)
90+ , testProperty "Word64" (prop_putget_list_simple :: [Word64] -> Property)
9191 ]
9292
9393 , testGroup "prop_putget_list_with_bitreq"
9494 [ testProperty "Word8" (prop_putget_list_with_bitreq :: [Word8] -> Property)
9595 , testProperty "Word16" (prop_putget_list_with_bitreq :: [Word16] -> Property)
9696 , testProperty "Word32" (prop_putget_list_with_bitreq :: [Word32] -> Property)
97− -- , testProperty "Word64" (prop_putget_list_with_bitreq :: [Word64] -> Property)
97+ , testProperty "Word64" (prop_putget_list_with_bitreq :: [Word64] -> Property)
9898 ]
9999 ]
100100