@@ -1,10 +1,10 @@
11{-# LANGUAGE GADTs, RankNTypes, MagicHash, CPP #-}
22
33module BitsGet
4− ( R(..)
5− , T(..)
6− , get
7− , getR
4+ ( -- R(..),
5+ T(..)
6+ -- , get
7+ -- , getR
88 , readBool
99 , readWord8
1010 , readWord16be
@@ -37,91 +37,12 @@ import GHC.Word
3737import GHC.Int
3838#endif
3939
40−data R a where
41− RBool :: R Bool
42− RWord8 :: Int -> R Word8
43− RWord16be :: Int -> R Word16
44− RWord32be :: Int -> R Word32
45− RByteString :: Int -> R ByteString
46− RThis :: a -> R a
47− RNextTo :: R a -> R b -> R (T a b)
48− RMap :: R b -> (b -> R a) -> R a
49− RMapPure :: R a -> (a -> b) -> R b
50− RList :: Int -> R a -> R [a]
51− RCheck :: R a -> (a -> Bool) -> String -> R a
52−
5340data T a b = !a :*: !b deriving (Show)
5441
55−instance Functor R where
56− fmap f m = RMapPure m f
57−
58−instance Show (R a) where
59− show r = case r of
60− RBool -> "Bool"
61−
62−size_in_bits :: forall a. R a -- ^ The record
63− -> Int -- ^ Number of bits
64−size_in_bits r = case r of
65− RBool -> 1
66− RWord8 n -> min n 8
67− RWord16be n -> min n 16
68− RWord32be n -> min n 16
69− RByteString n -> 8 * n
70− RThis _ -> 0
71− RList n r -> n * size_in_bits r
72− RMap r _ -> size_in_bits r
73− RMapPure r _ -> size_in_bits r
74− RCheck r _ _ -> size_in_bits r
75− RNextTo a b -> size_in_bits a + size_in_bits b
76−
7742data S = S !ByteString -- ^ Input
7843 !Int -- ^ Bit offset (0-7)
7944 deriving (Show)
8045
81−size_in_bytes :: forall a. R a
82− -> Int
83−size_in_bytes r = byte_offset (size_in_bits r + 7)
84−
85−get :: R a -> Get a
86−get r = do
87− bs <- getByteString (size_in_bytes r)
88− a :*: s <- getR (S bs 0) r
89− return a
90−
91−getR :: S -> R a -> Get (T a S)
92−getR s0 r = do
93− case r of
94− RBool -> return (readBool s0)
95− RWord8 n -> return (readWord8 s0 n)
96− RWord16be n -> return (readWord16be s0 n)
97− RWord32be n -> return (readWord32be s0 n)
98− RByteString n -> return (readByteString s0 n)
99− RThis x -> return (x :*: s0)
100− RNextTo a b -> do
101− t :*: s <- getR s0 a
102− u :*: s' <- getR s b
103− return (t:*:u:*:s')
104− RMap r p -> do
105− a :*: s@(S bs o) <- getR s0 r
106− let codepath = p a
107− required_bytes = byte_offset (size_in_bits r - o)
108− bs' <- getByteString required_bytes
109− getR (S (bs `append` bs') o) codepath
110− RMapPure r f -> do
111− a :*: s <- getR s0 r
112− return (f a :*: s)
113− RList n r ->
114− let loop 0 s acc = return (List.reverse acc :*: s)
115− loop m s acc = do
116− a :*: s' <- getR s r
117− loop (m-1) s' (a:acc)
118− in loop n s0 []
119− RCheck r c m -> do
120− a :*: s <- getR s0 r
121− if c a
122− then return (a :*: s)
123− else fail m
124−
12546-- make_mask 3 = 00000111
12647make_mask :: Bits a => Int -> a
12748make_mask n = (1 `shiftL` fromIntegral n) - 1
@@ -388,3 +309,86 @@ shiftr_w16 = shiftR
388309shiftr_w32 = shiftR
389310shiftr_w64 = shiftR
390311#endif
312+
313+{-
314+data R a where
315+ RBool :: R Bool
316+ RWord8 :: Int -> R Word8
317+ RWord16be :: Int -> R Word16
318+ RWord32be :: Int -> R Word32
319+ RByteString :: Int -> R ByteString
320+ RThis :: a -> R a
321+ RNextTo :: R a -> R b -> R (T a b)
322+ RMap :: R b -> (b -> R a) -> R a
323+ RMapPure :: R a -> (a -> b) -> R b
324+ RList :: Int -> R a -> R [a]
325+ RCheck :: R a -> (a -> Bool) -> String -> R a
326+
327+instance Functor R where
328+ fmap f m = RMapPure m f
329+
330+instance Show (R a) where
331+ show r = case r of
332+ RBool -> "Bool"
333+
334+size_in_bits :: forall a. R a -- ^ The record
335+ -> Int -- ^ Number of bits
336+size_in_bits r = case r of
337+ RBool -> 1
338+ RWord8 n -> min n 8
339+ RWord16be n -> min n 16
340+ RWord32be n -> min n 16
341+ RByteString n -> 8 * n
342+ RThis _ -> 0
343+ RList n r -> n * size_in_bits r
344+ RMap r _ -> size_in_bits r
345+ RMapPure r _ -> size_in_bits r
346+ RCheck r _ _ -> size_in_bits r
347+ RNextTo a b -> size_in_bits a + size_in_bits b
348+
349+size_in_bytes :: forall a. R a
350+ -> Int
351+size_in_bytes r = byte_offset (size_in_bits r + 7)
352+
353+get :: R a -> Get a
354+get r = do
355+ bs <- getByteString (size_in_bytes r)
356+ a :*: s <- getR (S bs 0) r
357+ return a
358+
359+getR :: S -> R a -> Get (T a S)
360+getR s0 r = do
361+ case r of
362+ RBool -> return (readBool s0)
363+ RWord8 n -> return (readWord8 s0 n)
364+ RWord16be n -> return (readWord16be s0 n)
365+ RWord32be n -> return (readWord32be s0 n)
366+ RByteString n -> return (readByteString s0 n)
367+ RThis x -> return (x :*: s0)
368+ RNextTo a b -> do
369+ t :*: s <- getR s0 a
370+ u :*: s' <- getR s b
371+ return (t:*:u:*:s')
372+ RMap r p -> do
373+ a :*: s@(S bs o) <- getR s0 r
374+ let codepath = p a
375+ required_bytes = byte_offset (size_in_bits r - o)
376+ bs' <- getByteString required_bytes
377+ getR (S (bs `append` bs') o) codepath
378+ RMapPure r f -> do
379+ a :*: s <- getR s0 r
380+ return (f a :*: s)
381+ RList n r ->
382+ let loop 0 s acc = return (List.reverse acc :*: s)
383+ loop m s acc = do
384+ a :*: s' <- getR s r
385+ loop (m-1) s' (a:acc)
386+ in loop n s0 []
387+ RCheck r c m -> do
388+ a :*: s <- getR s0 r
389+ if c a
390+ then return (a :*: s)
391+ else fail m
392+-}
393+
394+