master..4c202bb · binary-bits

.gitignore−1

@@ -1,4 +1,3 @@

11.cabal-sandbox

22cabal.sandbox.config

33dist/

4−.stack-work

BitsQC.hs+15−19

@@ -18,6 +18,7 @@ import Control.Applicative

1818import Data.Bits

1919import Data.Word

2020import Foreign.Storable

21+import System.Random

2122import Data.Traversable (traverse)

2223import Data.Foldable (traverse_)

2324

@@ -261,8 +262,8 @@ prop_fail lbs errMsg0 = forAll (choose (0, 8 * L.length lbs)) $ \len ->

261262 expectedBytesConsumed

262263 | bits == 0 = bytes

263264 | otherwise = bytes + 1

264− p = do _ <- getByteString (fromIntegral bytes)

265− _ <- getBits (fromIntegral bits) :: BitGet Word8

265+ p = do getByteString (fromIntegral bytes)

266+ getBits (fromIntegral bits) :: BitGet Word8

266267 fail errMsg0

267268 r = runGetIncremental (runBitGet p) `pushChunks` lbs

268269 in case r of

@@ -394,6 +395,11 @@ instance (Arbitrary (W a), Arbitrary (W b), Arbitrary (W c)) => Arbitrary (W (a,

394395 arbitrary = ((W .) .) . (,,) <$> arbitraryW <*> arbitraryW <*> arbitraryW

395396 shrink (W (a,b,c)) = ((W .) .) . (,,) <$> shrinkW a <*> shrinkW b <*> shrinkW c

396397

398+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

399+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

400+ fromIntegral b :: Integer) g of

401+ (x,g) -> (fromIntegral x, g)

402+

397403data Primitive

398404 = Bool Bool

399405 | W8 Int Word8

@@ -402,7 +408,6 @@ data Primitive

402408 | W64 Int Word64

403409 | BS Int B.ByteString

404410 | LBS Int L.ByteString

405− | Skip Int

406411 | IsEmpty

407412 deriving (Eq, Show)

408413

@@ -421,7 +426,6 @@ instance Arbitrary Primitive where

421426 , gen W16

422427 , gen W32

423428 , gen W64

424− , Skip <$> choose (0, 3000)

425429 , do n <- choose (0,10)

426430 cs <- vector n

427431 return (BS n (B.pack cs))

@@ -438,7 +442,6 @@ instance Arbitrary Primitive where

438442 W16 _ x -> snk W16 x

439443 W32 _ x -> snk W32 x

440444 W64 _ x -> snk W64 x

441− Skip x -> Skip <$> shrink x

442445 BS _ bs -> let ws = B.unpack bs in map (\ws' -> BS (length ws') (B.pack ws')) (shrink ws)

443446 LBS _ lbs -> let ws = L.unpack lbs in map (\ws' -> LBS (length ws') (L.pack ws')) (shrink ws)

444447 IsEmpty -> []

@@ -475,7 +478,6 @@ putPrimitive p =

475478 W16 n x -> putWord16 n x

476479 W32 n x -> putWord32 n x

477480 W64 n x -> putWord64 n x

478− Skip n -> skipBits n

479481 BS _ bs -> putByteString bs

480482 LBS _ lbs -> mapM_ putByteString (L.toChunks lbs)

481483 IsEmpty -> return ()

@@ -488,22 +490,10 @@ getPrimitive p =

488490 W16 n _ -> W16 n <$> getWord16 n

489491 W32 n _ -> W32 n <$> getWord32 n

490492 W64 n _ -> W64 n <$> getWord64 n

491− Skip n -> skipBits n >> return (Skip n)

492493 BS n _ -> BS n <$> getByteString n

493494 LBS n _ -> LBS n <$> getLazyByteString n

494495 IsEmpty -> isEmpty >> return IsEmpty

495496

496−getPrimitiveSize :: Primitive -> Int

497−getPrimitiveSize p = case p of

498− Bool _ -> 1

499− W8 n _ -> n

500− W16 n _ -> n

501− W32 n _ -> n

502− W64 n _ -> n

503− Skip n -> n

504− BS n _ -> n*8

505− LBS n _ -> n*8

506− IsEmpty -> 0

507497

508498verifyProgram :: Int -> Program -> BitGet Bool

509499verifyProgram totalLength ps0 = go 0 ps0

@@ -511,6 +501,13 @@ verifyProgram totalLength ps0 = go 0 ps0

511501 go _ [] = return True

512502 go pos (p:ps) =

513503 case p of

504+ Bool x -> check x getBool >> go (pos+1) ps

505+ W8 n x -> check x (getWord8 n) >> go (pos+n) ps

506+ W16 n x -> check x (getWord16 n) >> go (pos+n) ps

507+ W32 n x -> check x (getWord32 n) >> go (pos+n) ps

508+ W64 n x -> check x (getWord64 n) >> go (pos+n) ps

509+ BS n x -> check x (getByteString n) >> go (pos+(8*n)) ps

510+ LBS n x -> check x (getLazyByteString n) >> go (pos+(8*n)) ps

514511 IsEmpty -> do

515512 let expected = pos == totalLength

516513 actual <- isEmpty

@@ -518,7 +515,6 @@ verifyProgram totalLength ps0 = go 0 ps0

518515 then go pos ps

519516 else error $ "isEmpty returned wrong value, expected "

520517 ++ show expected ++ " but got " ++ show actual

521− _ -> check p (getPrimitive p) >> go (pos + getPrimitiveSize p) ps

522518 check x g = do

523519 y <- g

524520 if x == y

Data/Binary/Bits/Alignment.hsdeleted−22

@@ -1,22 +0,0 @@

1−-----------------------------------------------------------------------------

2−-- |

3−-- Module : Data.Binary.Bits.Get

4−-- Copyright : (c) Lennart Kolmodin 2010-2011

5−-- (c) Sylvain Henry 2015

6−-- License : BSD3-style (see LICENSE)

7−--

8−-- Maintainer : kolmodin@gmail.com

9−-- Stability : experimental

10−-- Portability : portable (should run where the package binary runs)

11−

12−module Data.Binary.Bits.Alignment

13− ( Alignable(..)

14− )

15−where

16−

17−class Monad m => Alignable m where

18− -- | Skip the given number of bits

19− skipBits :: Int -> m ()

20−

21− -- | Skip bits if necessary to align to the next byte

22− alignByte :: m ()

Data/Binary/Bits/BitOrder.hs+2−2

@@ -19,9 +19,9 @@ where

1919--

2020-- E.g. two words of 5 bits: ABCDE, VWXYZ

2121-- - BB: ABCDEVWX YZxxxxxx

22−-- - LL: XYZABCDE xxxxxxVW

22+-- - LB: XYZABCDE xxxxxxVW

2323-- - BL: EDCBAZYX WVxxxxxx

24−-- - LB: XWVEDCBA xxxxxxZY

24+-- - LL: XWVEDCBA xxxxxxZY

2525data BitOrder

2626 = BB -- ^ Big-endian bytes and bits

2727 | LB -- ^ Little-endian bytes, big-endian bits

Data/Binary/Bits/Get.hs+25−48

@@ -60,7 +60,6 @@ module Data.Binary.Bits.Get

6060

6161 -- ** Get bytes

6262 , getBool

63− , getBool#

6463 , getWord8

6564 , getWord16

6665 , getWord32

@@ -99,7 +98,6 @@ import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )

9998import Data.Binary.Get.Internal as B ( get, put, ensureN )

10099import Data.Binary.Bits.BitOrder

101100import Data.Binary.Bits.Internal

102−import Data.Binary.Bits.Alignment

103101

104102import Data.ByteString as B

105103import qualified Data.ByteString.Lazy as L

@@ -115,8 +113,6 @@ import Control.Applicative

115113import Control.Monad (when,foldM_)

116114

117115import Prelude as P

118−import GHC.Word

119−import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8#, (-#), Int#, xorI#, eqWord8#, TYPE)

120116

121117-- $bitget

122118-- Parse bits using a monad.

@@ -182,20 +178,8 @@ readBool :: S -> Bool

182178readBool (S bs o bo) = case bo of

183179 BB -> testBit (unsafeHead bs) (7-o)

184180 BL -> testBit (unsafeHead bs) (7-o)

185− LL -> testBit (unsafeHead bs) o

186181 LB -> testBit (unsafeHead bs) o

187−

188−-- | Read a single bit

189−readBool# :: S -> Int

190−readBool# (S bs (I# o) bo) = case bo of

191− BB -> testBit# (7# -# o)

192− BL -> testBit# (7# -# o)

193− LL -> testBit# o

194− LB -> testBit# o

195− where

196− !(W8# w) = unsafeHead bs

197− testBit# n = I# (((w `andWord8#` (wordToWord8# 1## `uncheckedShiftLWord8#` n)) `eqWord8#` wordToWord8# 0##) `xorI#` 1#)

198−

182+ LL -> testBit (unsafeHead bs) o

199183

200184-- | Extract a range of bits from (ws :: ByteString)

201185--

@@ -218,17 +202,17 @@ extract bo bs o n

218202

219203 -- shift offset depending on the byte position (0..B.length-1)

220204 off i = case bo of

221− LL -> 8*i - o

222205 LB -> 8*i - o

206+ LL -> 8*i - o

223207 BB -> (B.length bs -1 - i) * 8 - r

224208 BL -> (B.length bs -1 - i) * 8 - r

225209

226210 -- reverse bits if necessary

227211 rev = case bo of

228− LB -> reverseBits n

212+ LL -> reverseBits n

229213 BL -> reverseBits n

230214 BB -> id

231− LL -> id

215+ LB -> id

232216

233217

234218-- | Generic readWord

@@ -249,9 +233,9 @@ readWordChecked m n s

249233--

250234-- Examples:

251235-- BB: xxxABCDE FGHIJKLM NOPxxxxx -> ABCDEFGH IJKLMNOP

252−-- LL: LMNOPxxx DEFGHIJK xxxxxABC -> ABCDEFGH IJKLMNOP

236+-- LB: LMNOPxxx DEFGHIJK xxxxxABC -> ABCDEFGH IJKLMNOP

253237-- BL: xxxPONML KJIHGFED CBAxxxxx -> ABCDEFGH IJKLMNOP

254−-- LB: EDCBAxxx MLKJIHGF xxxxxPON -> ABCDEFGH IJKLMNOP

238+-- LL: EDCBAxxx MLKJIHGF xxxxxPON -> ABCDEFGH IJKLMNOP

255239readByteString :: Int -> S -> ByteString

256240readByteString n (S bs o bo) =

257241 let

@@ -260,12 +244,12 @@ readByteString n (S bs o bo) =

260244 rev = B.map (reverseBits 8)

261245 in case (o,bo) of

262246 (0,BB) -> bs''

263− (0,LL) -> B.reverse bs''

264− (0,LB) -> rev bs''

247+ (0,LB) -> B.reverse bs''

248+ (0,LL) -> rev bs''

265249 (0,BL) -> rev . B.reverse $ bs''

266− (_,LL) -> readByteString n (S (B.reverse bs') (8-o) BB)

250+ (_,LB) -> readByteString n (S (B.reverse bs') (8-o) BB)

267251 (_,BL) -> rev . B.reverse $ readByteString n (S bs' o BB)

268− (_,LB) -> rev . B.reverse $ readByteString n (S bs' o LL)

252+ (_,LL) -> rev . B.reverse $ readByteString n (S bs' o LB)

269253 (_,BB) -> unsafePerformIO $ do

270254 let len = n+1

271255 ptr <- mallocBytes len

@@ -287,6 +271,7 @@ newtype BitGet a = B { runState :: S -> Get (S,a) }

287271

288272instance Monad BitGet where

289273 return x = B $ \s -> return (s,x)

274+ fail str = B $ \s -> putBackState s >> fail str

290275 (B f) >>= g = B $ \s -> do (s',a) <- f s

291276 runState (g a) s'

292277

@@ -306,20 +291,6 @@ instance BitOrderable BitGet where

306291 (S _ _ bo) <- getState

307292 return bo

308293

309−instance Alignable BitGet where

310− -- | Skip the given number of bits

311− skipBits n = do

312− ensureBits n

313− withState (incS n)

314−

315− -- | Skip bits if necessary to align to the next byte

316− alignByte = do

317− (S _ o _) <- getState

318− when (o /= 0) $

319− skipBits (8-o)

320−

321−

322−

323294-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has

324295-- been partially consumed it will be discarded once 'runBitGet' is finished.

325296runBitGet :: BitGet a -> Get a

@@ -367,6 +338,20 @@ ensureBits n = do

367338 put B.empty

368339 return (S (bs`append`bs') o bo, ())

369340

341+-- | Skip the given number of bits

342+skipBits :: Int -> BitGet ()

343+skipBits n = do

344+ ensureBits n

345+ withState (incS n)

346+

347+-- | Skip bits if necessary to align to the next byte

348+alignByte :: BitGet ()

349+alignByte = do

350+ (S _ o _) <- getState

351+ when (o /= 0) $

352+ skipBits (8-o)

353+

354+

370355-- | Test whether all input has been consumed, i.e. there are no remaining

371356-- undecoded bytes.

372357isEmpty :: BitGet Bool

@@ -378,10 +363,6 @@ isEmpty = B $ \ (S bs o bo) -> if B.null bs

378363getBool :: BitGet Bool

379364getBool = block bool

380365

381−-- | Get 1 bit as a 'Bool'.

382−getBool# :: BitGet Int

383−getBool# = block bool#

384−

385366-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.

386367getWord8 :: Int -> BitGet Word8

387368getWord8 n = block (word8 n)

@@ -457,10 +438,6 @@ block (Block i p) = do

457438bool :: Block Bool

458439bool = Block 1 readBool

459440

460−-- | Read a 1 bit 'Bool'.

461−bool# :: Block Int

462−bool# = Block 1 readBool#

463−

464441-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.

465442word8 :: Int -> Block Word8

466443word8 n = Block n (readWordChecked 8 n)

Data/Binary/Bits/Internal.hs+6−27

@@ -12,13 +12,10 @@

1212

1313module Data.Binary.Bits.Internal

1414 ( make_mask

15− , make_mask#

1615 , mask

17− , mask#

1816 , bit_offset

1917 , byte_offset

2018 , reverseBits

21− , reverseBits#

2219 , FastBits(..)

2320 )

2421where

@@ -41,18 +38,11 @@ make_mask n = (1 `shiftL` fromIntegral n) - 1

4138{-# SPECIALIZE make_mask :: Int -> Word32 #-}

4239{-# SPECIALIZE make_mask :: Int -> Word64 #-}

4340

44−make_mask# :: Int# -> Word#

45−make_mask# n = (1## `shiftL#` n) `minusWord#` 1##

46−

4741-- | Keep only the n least-significant bits of the given value

4842mask :: (Bits a, Num a) => Int -> a -> a

4943mask n v = v .&. make_mask n

5044{-# INLINE mask #-}

5145

52−-- | Keep only the n least-significant bits of the given value

53−mask# :: Int# -> Word# -> Word#

54−mask# n v = v `and#` make_mask# n

55−

5646-- | Compute bit offset (equivalent to x `mod` 8 but faster)

5747bit_offset :: Int -> Int

5848bit_offset n = make_mask 3 .&. n

@@ -75,17 +65,6 @@ reverseBits n value = rec value n 0

7565 rec 0 i r = r `fastShiftL` i

7666 rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))

7767

78−reverseBits# :: Int# -> Word# -> Word#

79−reverseBits# n value = rec value n 0##

80− where

81− -- rec v i r, where

82− -- v is orginal value shifted

83− -- i is the remaining number of bits

84− -- r is current value

85− rec 0## 0# r = r

86− rec 0## i r = r `shiftL#` i

87− rec v i r = rec (v `shiftRL#` 1#) (i -# 1#) ((r `shiftL#` 1#) `or#` (v `and#` 0x1##))

88−

8968

9069---------------------------------------------------------------------

9170-- Unchecked shifts, from the "binary" package

@@ -137,13 +116,13 @@ shiftr_w32 :: Word32 -> Int -> Word32

137116shiftr_w64 :: Word64 -> Int -> Word64

138117

139118#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

140−shiftl_w8 w i = w `unsafeShiftL` i

141−shiftl_w16 w i = w `unsafeShiftL` i

142−shiftl_w32 w i = w `unsafeShiftL` i

119+shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)

120+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)

121+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)

143122

144−shiftr_w8 w i = w `unsafeShiftR` i

145−shiftr_w16 w i = w `unsafeShiftR` i

146−shiftr_w32 w i = w `unsafeShiftR` i

123+shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)

124+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)

125+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)

147126

148127

149128#if WORD_SIZE_IN_BITS < 64

Data/Binary/Bits/Put.hs+13−88

@@ -1,5 +1,3 @@

1−{-# LANGUAGE MagicHash #-}

2−

31-----------------------------------------------------------------------------

42-- |

53-- Module : Data.Binary.Bits.Put

@@ -22,10 +20,8 @@ module Data.Binary.Bits.Put

2220 -- * Data types

2321 -- ** Bool

2422 , putBool

25− , putBool#

2623

2724 -- ** Words

28− , putWord#

2925 , putWord8

3026 , putWord16

3127 , putWord32

@@ -45,16 +41,14 @@ import qualified Data.Binary.Put as Put

4541import Data.Binary.Put ( Put )

4642import Data.Binary.Bits.Internal

4743import Data.Binary.Bits.BitOrder

48−import Data.Binary.Bits.Alignment

4944

5045import Data.ByteString as BS

5146import Data.ByteString.Unsafe as BS

5247

53−import Control.Monad (when)

48+import Control.Applicative

5449import Data.Bits

50+import Data.Monoid

5551import Data.Word

56−import GHC.Base (Word#, shiftRL#, Int (..), Int#, (-#), (<#), isTrue#, (+#), shiftL#, wordToWord8#, orWord8#)

57−import GHC.Word (Word8(..))

5852

5953data BitPut a = BitPut { run :: (S -> PairS a) }

6054

@@ -66,18 +60,11 @@ data S = S !Builder !Word8 !Int !BitOrder

6660putBool :: Bool -> BitPut ()

6761putBool b = putWord8 1 (if b then 0xff else 0x00)

6862

69−-- | Put a 1 bit 'Bool'.

70−putBool# :: Word# -> BitPut ()

71−putBool# b = putWord# 1# b

72−

7363

7464-- | Generic putWord

7565putWord :: (Num a, FastBits a, Integral a) => Int -> a -> BitPut ()

7666putWord n w = BitPut $ \s -> PairS () (putWordS n w s)

7767

78−putWord# :: Int# -> Word# -> BitPut ()

79−putWord# n w = BitPut $ \s -> PairS () (putWordS# n w s)

80−

8168putWordS :: (Num a, FastBits a, Integral a) => Int -> a -> S -> S

8269putWordS n w s@(S builder b o bo) = s'

8370 where

@@ -96,8 +83,8 @@ putWordS n w s@(S builder b o bo) = s'

9683 w' = case bo of

9784 BB -> w

9885 BL -> w `fastShiftR` cn

99− LL -> w `fastShiftR` cn

100− LB -> w

86+ LB -> w `fastShiftR` cn

87+ LL -> w

10188

10289 -- Select bits to store in the current byte.

10390 -- Put them in the correct order and return them in the least-significant

@@ -105,8 +92,8 @@ putWordS n w s@(S builder b o bo) = s'

10592 selectBits :: (Num a, FastBits a, Integral a) => a -> Word8

10693 selectBits x = fromIntegral $ case bo of

10794 BB -> mask cn $ x `fastShiftR` (n-cn)

108− LB -> reverseBits cn $ mask cn $ x `fastShiftR` (n-cn)

109− LL -> mask cn x

95+ LL -> reverseBits cn $ mask cn $ x `fastShiftR` (n-cn)

96+ LB -> mask cn x

11097 BL -> reverseBits cn $ mask cn x

11198

11299 -- shift left at the correct position

@@ -114,55 +101,8 @@ putWordS n w s@(S builder b o bo) = s'

114101 shl x = case bo of

115102 BB -> x `fastShiftL` (8-o-cn)

116103 BL -> x `fastShiftL` (8-o-cn)

117− LL -> x `fastShiftL` o

118104 LB -> x `fastShiftL` o

119−

120− flush s2@(S b2 w2 o2 bo2)

121− | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2

122− | otherwise = s2

123−

124−putWordS# :: Int# -> Word# -> S -> S

125−putWordS# n w s@(S builder (W8# b) (I# o) bo) = s'

126− where

127− min# :: Int# -> Int# -> Int#

128− min# x y | isTrue# (x <# y) = x

129− min# _ y = y

130−

131− -- number of bits that will be stored in the current byte

132− cn = min# (8# -# o) n

133−

134− -- new state

135− s' = case n of

136− 0# -> s

137− _ -> putWordS# (n -# cn) w' (flush (S builder (W8# b') (I# (o +# cn)) bo))

138−

139− -- new current byte

140− b' = wordToWord8# (shl (selectBits w)) `orWord8#` b

141−

142− -- Word containing the remaining (n-cn) bits to store in its LSB

143− w' = case bo of

144− BB -> w

145− BL -> w `shiftRL#` cn

146− LL -> w `shiftRL#` cn

147− LB -> w

148−

149− -- Select bits to store in the current byte.

150− -- Put them in the correct order and return them in the least-significant

151− -- bits of the returned value

152− selectBits :: Word# -> Word#

153− selectBits x = case bo of

154− BB -> mask# cn (x `shiftRL#` (n -# cn))

155− LB -> reverseBits# cn (mask# cn (x `shiftRL#` (n -# cn)))

156− LL -> mask# cn x

157− BL -> reverseBits# cn (mask# cn x)

158−

159− -- shift left at the correct position

160− shl :: Word# -> Word#

161− shl x = case bo of

162− BB -> x `shiftL#` (8# -# o -# cn)

163− BL -> x `shiftL#` (8# -# o -# cn)

164− LL -> x `shiftL#` o

165− LB -> x `shiftL#` o

105+ LL -> x `fastShiftL` o

166106

167107 flush s2@(S b2 w2 o2 bo2)

168108 | o2 == 8 = S (b2 `mappend` B.singleton w2) 0 0 bo2

@@ -201,9 +141,9 @@ putWord64be = putWord

201141--

202142-- Examples: 3 bits are already written in the current byte

203143-- BB: ABCDEFGH IJKLMNOP -> xxxABCDE FGHIJKLM NOPxxxxx

204−-- LL: ABCDEFGH IJKLMNOP -> LMNOPxxx DEFGHIJK xxxxxABC

144+-- LB: ABCDEFGH IJKLMNOP -> LMNOPxxx DEFGHIJK xxxxxABC

205145-- BL: ABCDEFGH IJKLMNOP -> xxxPONML KJIHGFED CBAxxxxx

206−-- LB: ABCDEFGH IJKLMNOP -> EDCBAxxx MLKJIHGF xxxxxPON

146+-- LL: ABCDEFGH IJKLMNOP -> EDCBAxxx MLKJIHGF xxxxxPON

207147putByteString :: ByteString -> BitPut ()

208148putByteString bs = BitPut $ \s -> PairS () (putByteStringS bs s)

209149

@@ -212,13 +152,13 @@ putByteStringS bs s

212152 | BS.null bs = s

213153 | otherwise = case s of

214154 (S builder b 0 BB) -> S (builder `mappend` B.fromByteString bs) b 0 BB

215− (S builder b 0 LL) -> S (builder `mappend` B.fromByteString (BS.reverse bs)) b 0 LL

216− (S builder b 0 LB) -> S (builder `mappend` B.fromByteString (rev bs)) b 0 LB

155+ (S builder b 0 LB) -> S (builder `mappend` B.fromByteString (BS.reverse bs)) b 0 LB

156+ (S builder b 0 LL) -> S (builder `mappend` B.fromByteString (rev bs)) b 0 LL

217157 (S builder b 0 BL) -> S (builder `mappend` B.fromByteString (rev (BS.reverse bs))) b 0 BL

218158 (S _ _ _ BB) -> putByteStringS (BS.unsafeTail bs) (putWordS 8 (BS.unsafeHead bs) s)

219− (S _ _ _ LL) -> putByteStringS (BS.unsafeInit bs) (putWordS 8 (BS.unsafeLast bs) s)

159+ (S _ _ _ LB) -> putByteStringS (BS.unsafeInit bs) (putWordS 8 (BS.unsafeLast bs) s)

220160 (S _ _ _ BL) -> putByteStringS (BS.unsafeInit bs) (putWordS 8 (BS.unsafeLast bs) s)

221− (S _ _ _ LB) -> putByteStringS (BS.unsafeTail bs) (putWordS 8 (BS.unsafeHead bs) s)

161+ (S _ _ _ LL) -> putByteStringS (BS.unsafeTail bs) (putWordS 8 (BS.unsafeHead bs) s)

222162 where

223163 rev = BS.map (reverseBits 8)

224164

@@ -238,9 +178,6 @@ flushIncomplete s@(S b w o bo)

238178 | o == 0 = s

239179 | otherwise = (S (b `mappend` B.singleton w) 0 0 bo)

240180

241−getOffset :: BitPut Int

242−getOffset = BitPut $ \s@(S _ _ o _) -> PairS o s

243−

244181-- | Run the 'BitPut' monad inside 'Put'.

245182runBitPut :: BitPut () -> Put.Put

246183runBitPut m = Put.putBuilder b

@@ -271,15 +208,3 @@ instance BitOrderable BitPut where

271208 setBitOrder bo = BitPut $ \(S bu b o _) -> PairS () (S bu b o bo)

272209

273210 getBitOrder = BitPut $ \s@(S _ _ _ bo) -> PairS bo s

274−

275−instance Alignable BitPut where

276− -- | Skip the given number of bits

277− skipBits n

278− | n <= 64 = putWord64 n 0

279− | otherwise = putWord64 64 0 >> skipBits (n-64)

280−

281− -- | Skip bits if necessary to align to the next byte

282− alignByte = do

283− o <- getOffset

284− when (o /= 0) $

285− skipBits (8-o)

binary-bits.cabal+1−3

@@ -25,8 +25,7 @@ library

2525 exposed-modules: Data.Binary.Bits ,

2626 Data.Binary.Bits.Put ,

2727 Data.Binary.Bits.Get ,

28− Data.Binary.Bits.BitOrder ,

29− Data.Binary.Bits.Alignment

28+ Data.Binary.Bits.BitOrder

3029 other-modules: Data.Binary.Bits.Internal

3130

3231 default-language: Haskell98

@@ -37,7 +36,6 @@ test-suite qc

3736 type: exitcode-stdio-1.0

3837 main-is: BitsQC.hs

3938 default-language: Haskell98

40− --ghc-options: -O2 -Wall

4139

4240 build-depends: base==4.*, binary >= 0.6.0.0, bytestring,

4341 QuickCheck>=2, random,

flake.lockdeleted−59

@@ -1,59 +0,0 @@

1−{

2− "nodes": {

3− "flake-utils": {

4− "inputs": {

5− "systems": "systems"

6− },

7− "locked": {

8− "lastModified": 1731533236,

9− "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",

10− "owner": "numtide",

11− "repo": "flake-utils",

12− "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",

13− "type": "github"

14− },

15− "original": {

16− "id": "flake-utils",

17− "type": "indirect"

18− }

19− },

20− "nixpkgs": {

21− "locked": {

22− "lastModified": 1737469691,

23− "narHash": "sha256-nmKOgAU48S41dTPIXAq0AHZSehWUn6ZPrUKijHAMmIk=",

24− "owner": "NixOS",

25− "repo": "nixpkgs",

26− "rev": "9e4d5190a9482a1fb9d18adf0bdb83c6e506eaab",

27− "type": "github"

28− },

29− "original": {

30− "id": "nixpkgs",

31− "ref": "nixos-unstable",

32− "type": "indirect"

33− }

34− },

35− "root": {

36− "inputs": {

37− "flake-utils": "flake-utils",

38− "nixpkgs": "nixpkgs"

39− }

40− },

41− "systems": {

42− "locked": {

43− "lastModified": 1681028828,

44− "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",

45− "owner": "nix-systems",

46− "repo": "default",

47− "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",

48− "type": "github"

49− },

50− "original": {

51− "owner": "nix-systems",

52− "repo": "default",

53− "type": "github"

54− }

55− }

56− },

57− "root": "root",

58− "version": 7

59−}

flake.nixdeleted−24

@@ -1,24 +0,0 @@

1−{

2− inputs = {

3− nixpkgs.url = "nixpkgs/nixos-unstable";

4− flake-utils.url = "flake-utils";

5− };

6−

7− outputs = { self, flake-utils, nixpkgs }:

8− let

9− supportedSystems =

10− [ "x86_64-linux" "x86_64-darwin" "aarch64-darwin" "aarch64-linux" ];

11− compilerVersion = "966";

12− in flake-utils.lib.eachSystem supportedSystems (system:

13− let pkgs = import nixpkgs { inherit system; };

14− in {

15− devShells.default = pkgs.mkShell {

16− buildInputs = with pkgs; [

17− haskell.compiler."ghc${compilerVersion}"

18− (pkgs.haskell-language-server.override {

19− supportedGhcVersions = [ compilerVersion ];

20− })

21− ];

22− };

23− });

24−}

stack.yamldeleted−66

@@ -1,66 +0,0 @@

1−# This file was automatically generated by 'stack init'

2−#

3−# Some commonly used options have been documented as comments in this file.

4−# For advanced use and comprehensive documentation of the format, please see:

5−# https://docs.haskellstack.org/en/stable/yaml_configuration/

6−

7−# Resolver to choose a 'specific' stackage snapshot or a compiler version.

8−# A snapshot resolver dictates the compiler version and the set of packages

9−# to be used for project dependencies. For example:

10−#

11−# resolver: lts-3.5

12−# resolver: nightly-2015-09-21

13−# resolver: ghc-7.10.2

14−#

15−# The location of a snapshot can be provided as a file or url. Stack assumes

16−# a snapshot provided as a file might change, whereas a url resource does not.

17−#

18−# resolver: ./custom-snapshot.yaml

19−# resolver: https://example.com/snapshots/2018-01-01.yaml

20−resolver: lts-22.43

21−

22−# User packages to be built.

23−# Various formats can be used as shown in the example below.

24−#

25−# packages:

26−# - some-directory

27−# - https://example.com/foo/bar/baz-0.0.2.tar.gz

28−# subdirs:

29−# - auto-update

30−# - wai

31−packages:

32−- .

33−# Dependency packages to be pulled from upstream that are not in the resolver.

34−# These entries can reference officially published versions as well as

35−# forks / in-progress versions pinned to a git hash. For example:

36−#

37−# extra-deps:

38−# - acme-missiles-0.3

39−# - git: https://github.com/commercialhaskell/stack.git

40−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

41−#

42−# extra-deps: []

43−

44−# Override default flag values for local packages and extra-deps

45−# flags: {}

46−

47−# Extra package databases containing global packages

48−# extra-package-dbs: []

49−

50−# Control whether we use the GHC we find on the path

51−# system-ghc: true

52−#

53−# Require a specific version of stack, using version ranges

54−# require-stack-version: -any # Default

55−# require-stack-version: ">=2.9"

56−#

57−# Override the architecture used by stack, especially useful on Windows

58−# arch: i386

59−# arch: x86_64

60−#

61−# Extra directories used by stack for building

62−# extra-include-dirs: [/path/to/dir]

63−# extra-lib-dirs: [/path/to/dir]

64−#

65−# Allow a newer minor version of GHC than the snapshot specifies

66−# compiler-check: newer-minor

stack.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146

10− size: 720271

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml

12− original: lts-22.43