@@ -5,7 +5,6 @@ module Data.Binary.Bits.Get
55 , runBitGet
66 , runBitGetSimple
77 , BitGet
8− -- , joinGet
98
109 , getBool
1110 , getWord8
@@ -36,7 +35,7 @@ import Data.List as List ( reverse )
3635import Control.Applicative
3736
3837#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
39−import GHC.Base hiding ( (:*:) )
38+import GHC.Base
4039import GHC.Word
4140import GHC.Int
4241#endif
@@ -70,21 +69,6 @@ incS (S bs n) o =
7069 let (d,n') = divMod (n+o) 8
7170 in S (unsafeDrop d bs) n'
7271
73−{-
74−joinGet :: Get a -> BitGet a
75−joinGet m = C $ \s@(S bs o) kf ks -> do
76− -- put back the rest of the current chunk
77− case o of
78− 0 -> putS bs
79− _ -> putS (unsafeTail bs)
80− -- run the get function
81− a <- m
82− -- whatever is left, get it and us it as our state
83− bs' <- getS
84− let s' = S bs' 0
85− ks s' a
86−-}
87−
8872readByteString :: S -> Int -> T ByteString S
8973readByteString s@(S bs o) n
9074 | o == 0 = unsafeTake n bs :*: (S (unsafeDrop n bs) 0)
@@ -228,17 +212,15 @@ readWord64be s@(S bs o) n
228212-- unrolled codensity/state monad
229213newtype BitGet a = C { runCont :: forall r.
230214 S ->
231− Failure r ->
232215 Success a r ->
233− Get (Either String r) }
216+ Get r }
234217
235−type Failure r = String -> Get (Either String r)
236−type Success a r = S -> a -> Get (Either String r)
218+type Success a r = S -> a -> Get r
237219
238220instance Monad BitGet where
239− return x = C $ \s kf ks -> ks s x
240− fail str = C $ \s kf ks -> kf str
241− (C c) >>= f = C $ \s kf ks -> c s kf (\s' a -> runCont (f a) s' kf ks)
221+ return x = C $ \s ks -> ks s x
222+ fail str = C $ \s ks -> fail str
223+ (C c) >>= f = C $ \s ks -> c s (\s' a -> runCont (f a) s' ks)
242224
243225instance Functor BitGet where
244226 fmap f m = m >>= \a -> return (f a)
@@ -248,24 +230,14 @@ instance Applicative BitGet where
248230 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
249231
250232runBitGetSimple :: BitGet a -> Get a
251−runBitGetSimple bg = do
252− v <- runBitGet bg
253− case v of
254− Left err -> fail err
255− Right v -> return v
256−
257−runBitGet :: BitGet a -> Get (Either String a)
258−runBitGet bg = do
259− let bs = B.empty -- initial state
260− v <- runCont bg (S bs 0) (\str -> return (Left str)) (\s a -> return (Right (s, a)))
261− case v of
262− Left err -> return (Left err)
263− Right ((S _bs' _n), x) -> do
264− return (Right x)
233+runBitGetSimple bg = runBitGet bg
234+
235+runBitGet :: BitGet a -> Get a
236+runBitGet bg = runCont bg (S B.empty 0) (\_s a -> return a)
265237
266238-- | Make sure there are at lest @n@ bits.
267239ensureBits :: Int -> BitGet ()
268−ensureBits n = C $ \s kf ks ->
240+ensureBits n = C $ \s ks ->
269241 let loop (S bs o) | n <= (B.length bs * 8 - o) = ks (S bs o) ()
270242 | otherwise = do
271243 let currentBits = B.length bs * 8 - o
@@ -302,14 +274,14 @@ getByteString n = do
302274 in B.take n bs' :*: S (B.drop n bs') 0
303275
304276getState :: BitGet S
305−getState = C $ \s kf ks -> ks s s
277+getState = C $ \s ks -> ks s s
306278
307279putState :: S -> BitGet ()
308−putState s = C $ \_ kf ks -> ks s ()
280+putState s = C $ \_ ks -> ks s ()
309281
310282modifyState :: (S -> (T a S)) -> BitGet a
311−modifyState f = C $ \s kf ks -> case f s of
312− w :*: s' -> ks s' w
283+modifyState f = C $ \s ks -> case f s of
284+ w :*: s' -> ks s' w
313285
314286------------------------------------------------------------------------
315287-- Unchecked shifts, from the package binary