on master help sign in
commit153d2b391af0a775b6a1af9c84c3ae5c98e2cb72 authoriko <mail@iko.soy> dateThu 23 Jan 2025, 15:51 (2 years ago) parentf58ae47
5 files changed+111−7
Data/Binary/Bits/Get.hs+23 flake.lock+59 flake.nix+24 stack.yaml+1−2 stack.yaml.lock+4−5
Data/Binary/Bits/Get.hs+23
@@ -60,6 +60,7 @@ module Data.Binary.Bits.Get
6060
6161 -- ** Get bytes
6262 , getBool
63+ , getBool#
6364 , getWord8
6465 , getWord16
6566 , getWord32
@@ -114,6 +115,8 @@ import Control.Applicative
114115import Control.Monad (when,foldM_)
115116
116117import Prelude as P
118+import GHC.Word
119+import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8#, (-#), Int#, xorI#, eqWord8#, TYPE)
117120
118121-- $bitget
119122-- Parse bits using a monad.
@@ -182,6 +185,18 @@ readBool (S bs o bo) = case bo of
182185 LL -> testBit (unsafeHead bs) o
183186 LB -> testBit (unsafeHead bs) o
184187
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+
185200-- | Extract a range of bits from (ws :: ByteString)
186201--
187202-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
@@ -363,6 +378,10 @@ isEmpty = B $ \ (S bs o bo) -> if B.null bs
363378getBool :: BitGet Bool
364379getBool = block bool
365380
381+-- | Get 1 bit as a 'Bool'.
382+getBool# :: BitGet Int
383+getBool# = block bool#
384+
366385-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
367386getWord8 :: Int -> BitGet Word8
368387getWord8 n = block (word8 n)
@@ -438,6 +457,10 @@ block (Block i p) = do
438457bool :: Block Bool
439458bool = Block 1 readBool
440459
460+-- | Read a 1 bit 'Bool'.
461+bool# :: Block Int
462+bool# = Block 1 readBool#
463+
441464-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
442465word8 :: Int -> Block Word8
443466word8 n = Block n (readWordChecked 8 n)
flake.locknew file+59
@@ -0,0 +1,59 @@
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.nixnew file+24
@@ -0,0 +1,24 @@
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.yaml+1−2
@@ -17,8 +17,7 @@
1717#
1818# resolver: ./custom-snapshot.yaml
1919# resolver: https://example.com/snapshots/2018-01-01.yaml
20−resolver:
21− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
20+resolver: lts-22.43
2221
2322# User packages to be built.
2423# Various formats can be used as shown in the example below.
stack.yaml.lock+4−5
@@ -6,8 +6,7 @@
66packages: []
77snapshots:
88- completed:
9− sha256: 2e7d4a730d8eb5373b2d383fac84efcf7c81e3b7a5fce71b4c2e19a1768f25a6
10− size: 640239
11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
12− original:
13− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
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