@@ -37,8 +37,12 @@ data R a where
37 RWord8 :: Int -> R Word8
37 RWord8 :: Int -> R Word8
38 RWord16be :: Int -> R Word16
38 RWord16be :: Int -> R Word16
39 RWord32be :: Int -> R Word32
39 RWord32be :: Int -> R Word32
40+ RByteString :: Int -> R ByteString
40 RNextTo :: R a -> R b -> R (T a b)
42 RNextTo :: R a -> R b -> R (T a b)
43+ RMap :: R b -> (b -> R a) -> R a
44+ RMapPure :: R a -> (a -> b) -> R b
41− RList :: R a -> Int -> R [a]
45+ RList :: Int -> R a -> R [a]
42 RCheck :: R a -> (a -> Bool) -> String -> R a
46 RCheck :: R a -> (a -> Bool) -> String -> R a
44data T a b = !a :*: !b deriving (Show)
48data T a b = !a :*: !b deriving (Show)
@@ -54,8 +58,11 @@ size_in_bits r = case r of
54 RWord8 n -> min n 8
58 RWord8 n -> min n 8
55 RWord16be n -> min n 16
59 RWord16be n -> min n 16
56 RWord32be n -> min n 16
60 RWord32be n -> min n 16
61+ RByteString n -> 8 * n
57− RList r n -> n * size_in_bits r
63+ RList n r -> n * size_in_bits r
58− --RCase r cs -> size_in_bits r + maximum (map size_in_bits cs)
64+ RMap r _ -> size_in_bits r
65+ RMapPure r _ -> size_in_bits r
59 RCheck r _ _ -> size_in_bits r
66 RCheck r _ _ -> size_in_bits r
60 RNextTo a b -> size_in_bits a + size_in_bits b
67 RNextTo a b -> size_in_bits a + size_in_bits b
@@ -65,7 +72,7 @@ data S = S !ByteString -- ^ Input
66size_in_bytes :: forall a. R a
73size_in_bytes :: forall a. R a
68−size_in_bytes r = (size_in_bits r + 7) `div` 8
75+size_in_bytes r = byte_offset (size_in_bits r + 7)
70get :: R a -> Get a
77get :: R a -> Get a
@@ -73,17 +80,29 @@ get r = do
73 a :*: s <- getS (S bs 0) r
80 a :*: s <- getS (S bs 0) r
76−getS :: Monad m => S -> R a -> m (T a S)
83+getS :: S -> R a -> Get (T a S)
77getS s0 r = do
84getS s0 r = do
79 RBool -> return (readBool s0)
86 RBool -> return (readBool s0)
80 RWord8 n -> return (readWord8 s0 n)
87 RWord8 n -> return (readWord8 s0 n)
81 RWord16be n -> return (readWord16be s0 n)
88 RWord16be n -> return (readWord16be s0 n)
89+ RWord32be n -> return (readWord32be s0 n)
90+ RByteString n -> return (readByteString s0 n)
91+ RThis x -> return (x :*: s0)
82 RNextTo a b -> do
92 RNextTo a b -> do
83 t :*: s <- getS s0 a
93 t :*: s <- getS s0 a
84 u :*: s' <- getS s b
94 u :*: s' <- getS s b
85 return (t:*:u:*:s')
95 return (t:*:u:*:s')
97+ a :*: s@(S bs o) <- getS s0 r
99+ required_bytes = byte_offset (size_in_bits r - o)
100+ bs' <- getByteString required_bytes
101+ getS (S (bs `append` bs') o) codepath
103+ a :*: s <- getS s0 r
86− RList r n ->
105+ RList n r ->
87 let loop 0 s acc = return (List.reverse acc :*: s)
106 let loop 0 s acc = return (List.reverse acc :*: s)
88 loop m s acc = do
107 loop m s acc = do
89 a :*: s' <- getS s r
108 a :*: s' <- getS s r
@@ -118,6 +137,12 @@ incS (S bs n) o =
118 let (d,n') = divMod (n+o) 8
137 let (d,n') = divMod (n+o) 8
119 in S (unsafeDrop d bs) n'
138 in S (unsafeDrop d bs) n'
141+readByteString :: S -> Int -> T ByteString S
142+readByteString s@(S bs o) n
143+ | o == 0 = unsafeTake n bs :*: (S (unsafeDrop n bs) 0)
144+ | otherwise = unsafeTake n (unsafeTail bs) :*: (S (unsafeDrop (n+1) bs) 0)
121readWord8 :: S -> Int -> T Word8 S
146readWord8 :: S -> Int -> T Word8 S
122readWord8 s@(S bs o) n
147readWord8 s@(S bs o) n
123 -- no bits at all, return 0
148 -- no bits at all, return 0
@@ -166,24 +191,31 @@ readWord16be s@(S bs o) n
166 in w :*: incS s n
191 in w :*: incS s n
168 -- with offset, and n=9-16
193 -- with offset, and n=9-16
169− | n <= 16 = let bits_in_msb = 8 - o
194+ | n <= 16 = readWithOffset s shiftl_w16 shiftr_w16 n
170− (n',top) = (n - bits_in_msb
171− , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shiftl_w16` (n - bits_in_msb))
173− segs = byte_offset n
175− bn 1 = fromIntegral (unsafeIndex bs 1)
196+ | otherwise = error "readWord16be: tried to read more than 16 bits"
176− bn n = (bn (n-1) `shiftl_w16` 8) .|. fromIntegral (unsafeIndex bs n)
178− mseg = bn segs
198+readWithoutOffset s@(S bs o) shifterL shifterR n
199+ | o /= 0 = error "readWithoutOffset: there is an offset"
180− last | bit_offset n' > 0 = (fromIntegral (unsafeIndex bs (segs + 1))) `shiftr_w16` (8 - (bit_offset n'))
201+ -- | n == 8 = readWord8 s n
181− | otherwise = 0
202+ -- | n == 16 = readWord16be s n
203+ | n == 24 || n == 32 =
204+ let segs = byte_offset n
205+ bn 0 = fromIntegral (unsafeHead bs)
206+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
183− w = top .|. mseg .|. last
184− in w :*: incS s n
208+ in (bn (segs-1) :*: incS s n)
186− | otherwise = error "readWord16be: tried to read more than 16 bits"
210+ | n <= 64 = let segs = byte_offset n
212+ bn 0 = fromIntegral (unsafeHead bs)
213+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
215+ last = (fromIntegral (unsafeIndex bs (segs + 1))) `shifterR` (8 - (bit_offset n))
217+ w = bn segs .|. last
188readWithOffset s@(S bs o) shifterL shifterR n
220readWithOffset s@(S bs o) shifterL shifterR n
189 | n <= 64 = let bits_in_msb = 8 - o
221 | n <= 64 = let bits_in_msb = 8 - o
@@ -214,8 +246,12 @@ readWord32be s@(S bs o) n
214 | n <= 16 = let w :*: s' = readWord16be s n
246 | n <= 16 = let w :*: s' = readWord16be s n
215 in fromIntegral w :*: s'
247 in fromIntegral w :*: s'
217− -- not implemented
249+ | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
250+ -- error "readWord32be: can't read without offset..."
252+ | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
218− | otherwise = error "readWord32be: Not fully implemented"
254+ | otherwise = error "readWord32be: tried to read more than 32 bits"