master..1bfa8cb · binary-bits

.gitignore−1

since splitsnapshots

unifiedsplit

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

1.cabal-sandbox

2cabal.sandbox.config

3dist/

4−.stack-work

Data/Binary/Bits/Get.hs+1−23

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

60

61 -- ** Get bytes

62 , getBool

63− , getBool#

64 , getWord8

63 , getWord8

65 , getWord16

64 , getWord16

66 , getWord32

65 , getWord32

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

115import Control.Monad (when,foldM_)

114import Control.Monad (when,foldM_)

116

115

117import Prelude as P

116import Prelude as P

118−import GHC.Word

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

120

117

121-- $bitget

118-- $bitget

122-- Parse bits using a monad.

119-- Parse bits using a monad.

@@ -185,18 +182,6 @@ readBool (S bs o bo) = case bo of

185 LL -> testBit (unsafeHead bs) o

182 LL -> testBit (unsafeHead bs) o

186 LB -> testBit (unsafeHead bs) o

183 LB -> testBit (unsafeHead bs) o

187

184

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−

199−

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

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

201--

186--

202-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws

187-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws

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

287

272

288instance Monad BitGet where

273instance Monad BitGet where

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

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

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

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

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

291 runState (g a) s'

277 runState (g a) s'

292

278

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

378getBool :: BitGet Bool

364getBool :: BitGet Bool

379getBool = block bool

365getBool = block bool

380

366

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

382−getBool# :: BitGet Int

383−getBool# = block bool#

384−

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

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

386getWord8 :: Int -> BitGet Word8

368getWord8 :: Int -> BitGet Word8

387getWord8 n = block (word8 n)

369getWord8 n = block (word8 n)

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

457bool :: Block Bool

439bool :: Block Bool

458bool = Block 1 readBool

440bool = Block 1 readBool

459

441

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

461−bool# :: Block Int

462−bool# = Block 1 readBool#

463−

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

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

465word8 :: Int -> Block Word8

443word8 :: Int -> Block Word8

466word8 n = Block n (readWordChecked 8 n)

444word8 n = Block n (readWordChecked 8 n)

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

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

12

13module Data.Binary.Bits.Internal

14 ( make_mask

15− , make_mask#

16 , mask

15 , mask

17− , mask#

18 , bit_offset

16 , bit_offset

19 , byte_offset

17 , byte_offset

20 , reverseBits

18 , reverseBits

21− , reverseBits#

22 , FastBits(..)

19 , FastBits(..)

23 )

20 )

24where

21where

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

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

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

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

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

43

40

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

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

46−

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

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

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

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

49mask n v = v .&. make_mask n

43mask n v = v .&. make_mask n

50{-# INLINE mask #-}

44{-# INLINE mask #-}

51

45

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−

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

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

57bit_offset :: Int -> Int

47bit_offset :: Int -> Int

58bit_offset n = make_mask 3 .&. n

48bit_offset n = make_mask 3 .&. n

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

75 rec 0 i r = r `fastShiftL` i

65 rec 0 i r = r `fastShiftL` i

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

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

77

67

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−

89

68

90---------------------------------------------------------------------

69---------------------------------------------------------------------

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

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

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

137shiftr_w64 :: Word64 -> Int -> Word64

116shiftr_w64 :: Word64 -> Int -> Word64

138

117

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

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

140−shiftl_w8 w i = w `unsafeShiftL` i

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

141−shiftl_w16 w i = w `unsafeShiftL` i

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

142−shiftl_w32 w i = w `unsafeShiftL` i

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

143

122

144−shiftr_w8 w i = w `unsafeShiftR` i

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

145−shiftr_w16 w i = w `unsafeShiftR` i

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

146−shiftr_w32 w i = w `unsafeShiftR` i

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

147

126

148

127

149#if WORD_SIZE_IN_BITS < 64

128#if WORD_SIZE_IN_BITS < 64

Data/Binary/Bits/Put.hs+2−60

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

1−{-# LANGUAGE MagicHash #-}

2−

3-----------------------------------------------------------------------------

1-----------------------------------------------------------------------------

4-- |

2-- |

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

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

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

22 -- * Data types

20 -- * Data types

23 -- ** Bool

21 -- ** Bool

24 , putBool

22 , putBool

25− , putBool#

26

23

27 -- ** Words

24 -- ** Words

28− , putWord#

29 , putWord8

25 , putWord8

30 , putWord16

26 , putWord16

31 , putWord32

27 , putWord32

@@ -50,11 +46,11 @@ import Data.Binary.Bits.Alignment

50import Data.ByteString as BS

46import Data.ByteString as BS

51import Data.ByteString.Unsafe as BS

47import Data.ByteString.Unsafe as BS

52

48

49+import Control.Applicative

53import Control.Monad (when)

50import Control.Monad (when)

54import Data.Bits

51import Data.Bits

52+import Data.Monoid

55import Data.Word

53import Data.Word

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

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

58

54

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

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

60

56

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

66putBool :: Bool -> BitPut ()

62putBool :: Bool -> BitPut ()

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

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

68

64

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

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

71−putBool# b = putWord# 1# b

72−

73

65

74-- | Generic putWord

66-- | Generic putWord

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

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

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

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

77

69

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

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

80−

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

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

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

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

83 where

72 where

@@ -121,53 +110,6 @@ putWordS n w s@(S builder b o bo) = s'

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

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

122 | otherwise = s2

111 | otherwise = s2

123

112

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

166−

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

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

169− | otherwise = s2

170−

171

113

172-- | Put the @n@ lower bits of a 'Word8'.

114-- | Put the @n@ lower bits of a 'Word8'.

173putWord8 :: Int -> Word8 -> BitPut ()

115putWord8 :: Int -> Word8 -> BitPut ()

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