on master help sign in
Enable get/putWord64be, add BinaryBit instance, enable tests
7a56f9eLennart Kolmodin
Bits.hs−2
@@ -25,8 +25,6 @@ instance BinaryBit Word32 where
25 putBits = putWord32be
25 putBits = putWord32be
26 getBits = getWord32be
26 getBits = getWord32be
27
27
28−{-
29instance BinaryBit Word64 where
28instance BinaryBit Word64 where
30 putBits = putWord64be
29 putBits = putWord64be
31 getBits = getWord64be
30 getBits = getWord64be
32−-}
BitsGet.hs+9−5
@@ -11,6 +11,7 @@ module BitsGet
11 , getWord8
11 , getWord8
12 , getWord16be
12 , getWord16be
13 , getWord32be
13 , getWord32be
14+ , getWord64be
14
15
15 , readBool
16 , readBool
16 , readWord8
17 , readWord8
@@ -199,7 +200,7 @@ readWord32be s@(S bs o) n
199 | otherwise = error "readWord32be: tried to read more than 32 bits"
200 | otherwise = error "readWord32be: tried to read more than 32 bits"
200
201
201
202
202−readWord64be :: S -> Int -> T Word32 S
203+readWord64be :: S -> Int -> T Word64 S
203readWord64be s@(S bs o) n
204readWord64be s@(S bs o) n
204 -- 8 or fewer bits, use readWord8
205 -- 8 or fewer bits, use readWord8
205 | n <= 8 = let w :*: s' = readWord8 s n
206 | n <= 8 = let w :*: s' = readWord8 s n
@@ -209,9 +210,9 @@ readWord64be s@(S bs o) n
209 | n <= 16 = let w :*: s' = readWord16be s n
210 | n <= 16 = let w :*: s' = readWord16be s n
210 in fromIntegral w :*: s'
211 in fromIntegral w :*: s'
211
212
212− | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
213+ | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
213
214
214− | n <= 64 = readWithOffset s shiftl_w32 shiftr_w32 n
215+ | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
215
216
216 | otherwise = error "readWord64be: tried to read more than 64 bits"
217 | otherwise = error "readWord64be: tried to read more than 64 bits"
217
218
@@ -273,13 +274,16 @@ getBool = ensure 1 >> modifyState readBool
273
274
274getWord8 :: Int -> BitGet Word8
275getWord8 :: Int -> BitGet Word8
275getWord8 n = ensure n >> modifyState (flip readWord8 n)
276getWord8 n = ensure n >> modifyState (flip readWord8 n)
276−
277+
277getWord16be :: Int -> BitGet Word16
278getWord16be :: Int -> BitGet Word16
278getWord16be n = ensure n >> modifyState (flip readWord16be n)
279getWord16be n = ensure n >> modifyState (flip readWord16be n)
279
280
280getWord32be :: Int -> BitGet Word32
281getWord32be :: Int -> BitGet Word32
281getWord32be n = ensure n >> modifyState (flip readWord32be n)
282getWord32be n = ensure n >> modifyState (flip readWord32be n)
282−
283+
284+getWord64be :: Int -> BitGet Word64
285+getWord64be n = ensure n >> modifyState (flip readWord64be n)
286+
283getState :: BitGet S
287getState :: BitGet S
284getState = C $ \s kf ks -> ks s s
288getState = C $ \s kf ks -> ks s s
285
289
BitsPut.hs+3
@@ -28,6 +28,9 @@ data PairS a = PairS a {-# UNPACK #-} !S
28
28
29data S = S !Builder !Word8 !Int
29data S = S !Builder !Word8 !Int
30
30
31+instance Show S where
32+ show (S _ w o) = "S( " ++ show w ++ " : " ++ show o ++ ")"
33+
31putBool :: Bool -> BitPut ()
34putBool :: Bool -> BitPut ()
32putBool b = putWord8 1 (if b then 1 else 0)
35putBool b = putWord8 1 (if b then 1 else 0)
33
36
BitsQC.hs+7−7
@@ -51,35 +51,35 @@ tests =
51 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: [Word8] -> Property)
51 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: [Word8] -> Property)
52 , testProperty "Word16" (prop_bitput_with_get_from_binary :: [Word16] -> Property)
52 , testProperty "Word16" (prop_bitput_with_get_from_binary :: [Word16] -> Property)
53 , testProperty "Word32" (prop_bitput_with_get_from_binary :: [Word32] -> Property)
53 , 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)
55 ]
55 ]
56
56
57 , testGroup "prop_bitget_with_put_from_binary"
57 , testGroup "prop_bitget_with_put_from_binary"
58 [ testProperty "Word8" (prop_bitget_with_put_from_binary :: [Word8] -> Property)
58 [ testProperty "Word8" (prop_bitget_with_put_from_binary :: [Word8] -> Property)
59 , testProperty "Word16" (prop_bitget_with_put_from_binary :: [Word16] -> Property)
59 , testProperty "Word16" (prop_bitget_with_put_from_binary :: [Word16] -> Property)
60 , testProperty "Word32" (prop_bitget_with_put_from_binary :: [Word32] -> Property)
60 , 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)
62 ]
62 ]
63
63
64 , testGroup "prop_compare_put_with_naive"
64 , testGroup "prop_compare_put_with_naive"
65 [ testProperty "Word8" (prop_compare_put_with_naive :: [Word8] -> Property)
65 [ testProperty "Word8" (prop_compare_put_with_naive :: [Word8] -> Property)
66 , testProperty "Word16" (prop_compare_put_with_naive :: [Word16] -> Property)
66 , testProperty "Word16" (prop_compare_put_with_naive :: [Word16] -> Property)
67 , testProperty "Word32" (prop_compare_put_with_naive :: [Word32] -> Property)
67 , 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)
69 ]
69 ]
70
70
71 , testGroup "prop_compare_get_with_naive"
71 , testGroup "prop_compare_get_with_naive"
72 [ testProperty "Word8" (prop_compare_get_with_naive:: [Word8] -> Property)
72 [ testProperty "Word8" (prop_compare_get_with_naive:: [Word8] -> Property)
73 , testProperty "Word16" (prop_compare_get_with_naive:: [Word16] -> Property)
73 , testProperty "Word16" (prop_compare_get_with_naive:: [Word16] -> Property)
74 , testProperty "Word32" (prop_compare_get_with_naive:: [Word32] -> Property)
74 , 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)
76 ]
76 ]
77
77
78 , testGroup "prop_put_with_bitreq"
78 , testGroup "prop_put_with_bitreq"
79 [ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)
79 [ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)
80 , testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)
80 , testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)
81 , testProperty "Word32" (prop_putget_with_bitreq :: Word32 -> Property)
81 , 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)
83 ]
83 ]
84
84
85 , testGroup "prop_putget_list_simple"
85 , testGroup "prop_putget_list_simple"
@@ -87,14 +87,14 @@ tests =
87 , testProperty "Word8" (prop_putget_list_simple :: [Word8] -> Property)
87 , testProperty "Word8" (prop_putget_list_simple :: [Word8] -> Property)
88 , testProperty "Word16" (prop_putget_list_simple :: [Word16] -> Property)
88 , testProperty "Word16" (prop_putget_list_simple :: [Word16] -> Property)
89 , testProperty "Word32" (prop_putget_list_simple :: [Word32] -> Property)
89 , 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)
91 ]
91 ]
92
92
93 , testGroup "prop_putget_list_with_bitreq"
93 , testGroup "prop_putget_list_with_bitreq"
94 [ testProperty "Word8" (prop_putget_list_with_bitreq :: [Word8] -> Property)
94 [ testProperty "Word8" (prop_putget_list_with_bitreq :: [Word8] -> Property)
95 , testProperty "Word16" (prop_putget_list_with_bitreq :: [Word16] -> Property)
95 , testProperty "Word16" (prop_putget_list_with_bitreq :: [Word16] -> Property)
96 , testProperty "Word32" (prop_putget_list_with_bitreq :: [Word32] -> Property)
96 , 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)
98 ]
98 ]
99 ]
99 ]
100
100