@@ -1,6 +1,7 @@
11module BitsPut
22 ( putBool
33 , putWord8
4+ , putWord16be
45 , runBitPut
56 )
67 where
@@ -43,7 +44,21 @@ putWord16be n w
4344 | otherwise =
4445 BitPut $ \s -> PairS () $
4546 case s of
46− (S b t o) | otherwise -> undefined
47+ -- as n>=9, it's too big to fit into one single byte
48+ -- it'll either use 2 or 3 bytes
49+ -- it'll fit in 2 bytes
50+ (S b t o) | o + n <= 16 -> flush $
51+ let o' = o + n - 8
52+ w' = t .|. fromIntegral (w `shiftR` o')
53+ t' = fromIntegral (w `shiftL` (8-o'))
54+ in (S (b `mappend` B.singleton w') t' o')
55+ -- 3 bytes required
56+ | otherwise -> flush $
57+ let o' = o + n - 16
58+ w' = t .|. fromIntegral (w `shiftR` (o' + 8))
59+ w'' = fromIntegral ((w `shiftR` o') .&. 0xff)
60+ t' = fromIntegral (w `shiftL` (8-o'))
61+ in (S (b `mappend` B.singleton w' `mappend` B.singleton w'') t' o')
4762
4863flush :: S -> S
4964flush s@(S b w o)