@@ -37,8 +37,12 @@ data R a where
3737 RWord8 :: Int -> R Word8
3838 RWord16be :: Int -> R Word16
3939 RWord32be :: Int -> R Word32
40+ RByteString :: Int -> R ByteString
41+ RThis :: a -> R a
4042 RNextTo :: R a -> R b -> R (T a b)
41− RList :: R a -> Int -> R [a]
43+ RMap :: R b -> (b -> R a) -> R a
44+ RMapPure :: R a -> (a -> b) -> R b
45+ RList :: Int -> R a -> R [a]
4246 RCheck :: R a -> (a -> Bool) -> String -> R a
4347
4448data T a b = !a :*: !b deriving (Show)
@@ -54,8 +58,11 @@ size_in_bits r = case r of
5458 RWord8 n -> min n 8
5559 RWord16be n -> min n 16
5660 RWord32be n -> min n 16
57− RList r n -> n * size_in_bits r
58− --RCase r cs -> size_in_bits r + maximum (map size_in_bits cs)
61+ RByteString n -> 8 * n
62+ RThis _ -> 0
63+ RList n r -> n * size_in_bits r
64+ RMap r _ -> size_in_bits r
65+ RMapPure r _ -> size_in_bits r
5966 RCheck r _ _ -> size_in_bits r
6067 RNextTo a b -> size_in_bits a + size_in_bits b
6168
@@ -65,7 +72,7 @@ data S = S !ByteString -- ^ Input
6572
6673size_in_bytes :: forall a. R a
6774 -> Int
68−size_in_bytes r = (size_in_bits r + 7) `div` 8
75+size_in_bytes r = byte_offset (size_in_bits r + 7)
6976
7077get :: R a -> Get a
7178get r = do
@@ -73,17 +80,29 @@ get r = do
7380 a :*: s <- getS (S bs 0) r
7481 return a
7582
76−getS :: Monad m => S -> R a -> m (T a S)
83+getS :: S -> R a -> Get (T a S)
7784getS s0 r = do
7885 case r of
7986 RBool -> return (readBool s0)
8087 RWord8 n -> return (readWord8 s0 n)
8188 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)
8292 RNextTo a b -> do
8393 t :*: s <- getS s0 a
8494 u :*: s' <- getS s b
8595 return (t:*:u:*:s')
86− RList r n ->
96+ RMap r p -> do
97+ a :*: s@(S bs o) <- getS s0 r
98+ let codepath = p a
99+ required_bytes = byte_offset (size_in_bits r - o)
100+ bs' <- getByteString required_bytes
101+ getS (S (bs `append` bs') o) codepath
102+ RMapPure r f -> do
103+ a :*: s <- getS s0 r
104+ return (f a :*: s)
105+ RList n r ->
87106 let loop 0 s acc = return (List.reverse acc :*: s)
88107 loop m s acc = do
89108 a :*: s' <- getS s r
@@ -118,6 +137,12 @@ incS (S bs n) o =
118137 let (d,n') = divMod (n+o) 8
119138 in S (unsafeDrop d bs) n'
120139
140+
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)
145+
121146readWord8 :: S -> Int -> T Word8 S
122147readWord8 s@(S bs o) n
123148 -- no bits at all, return 0
@@ -166,24 +191,31 @@ readWord16be s@(S bs o) n
166191 in w :*: incS s n
167192
168193 -- with offset, and n=9-16
169− | n <= 16 = let bits_in_msb = 8 - o
170− (n',top) = (n - bits_in_msb
171− , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shiftl_w16` (n - bits_in_msb))
172−
173− segs = byte_offset n
194+ | n <= 16 = readWithOffset s shiftl_w16 shiftr_w16 n
174195
175− bn 1 = fromIntegral (unsafeIndex bs 1)
176− bn n = (bn (n-1) `shiftl_w16` 8) .|. fromIntegral (unsafeIndex bs n)
196+ | otherwise = error "readWord16be: tried to read more than 16 bits"
177197
178− mseg = bn segs
198+readWithoutOffset s@(S bs o) shifterL shifterR n
199+ | o /= 0 = error "readWithoutOffset: there is an offset"
179200
180− last | bit_offset n' > 0 = (fromIntegral (unsafeIndex bs (segs + 1))) `shiftr_w16` (8 - (bit_offset n'))
181− | otherwise = 0
201+ -- | n == 8 = readWord8 s n
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)
182207
183− w = top .|. mseg .|. last
184− in w :*: incS s n
208+ in (bn (segs-1) :*: incS s n)
185209
186− | otherwise = error "readWord16be: tried to read more than 16 bits"
210+ | n <= 64 = let segs = byte_offset n
211+
212+ bn 0 = fromIntegral (unsafeHead bs)
213+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
214+
215+ last = (fromIntegral (unsafeIndex bs (segs + 1))) `shifterR` (8 - (bit_offset n))
216+
217+ w = bn segs .|. last
218+ in w :*: incS s n
187219
188220readWithOffset s@(S bs o) shifterL shifterR n
189221 | n <= 64 = let bits_in_msb = 8 - o
@@ -214,8 +246,12 @@ readWord32be s@(S bs o) n
214246 | n <= 16 = let w :*: s' = readWord16be s n
215247 in fromIntegral w :*: s'
216248
217− -- not implemented
218− | otherwise = error "readWord32be: Not fully implemented"
249+ | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
250+ -- error "readWord32be: can't read without offset..."
251+
252+ | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
253+
254+ | otherwise = error "readWord32be: tried to read more than 32 bits"
219255
220256{-
221257