bitvec 1.0.2.0 → 1.0.3.0
raw patch · 11 files changed
+279/−198 lines, 11 filesdep −bits-extradep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: bits-extra
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.Bit: castFromWords8 :: Vector Word8 -> Vector Bit
+ Data.Bit: castToWords8 :: Vector Bit -> Maybe (Vector Word8)
+ Data.Bit: cloneToWords8 :: Vector Bit -> Vector Word8
+ Data.Bit.ThreadSafe: castFromWords8 :: Vector Word8 -> Vector Bit
+ Data.Bit.ThreadSafe: castToWords8 :: Vector Bit -> Maybe (Vector Word8)
+ Data.Bit.ThreadSafe: cloneToWords8 :: Vector Bit -> Vector Word8
Files
- README.md +0/−5
- bitvec.cabal +5/−15
- changelog.md +6/−0
- src/Data/Bit.hs +4/−0
- src/Data/Bit/Immutable.hs +127/−12
- src/Data/Bit/Mutable.hs +24/−2
- src/Data/Bit/PdepPext.hs +54/−0
- src/Data/Bit/Select1.hs +0/−149
- src/Data/Bit/Utils.hs +12/−9
- test/Support.hs +6/−6
- test/Tests/Vector.hs +41/−0
README.md view
@@ -161,11 +161,6 @@ (`brew install gmp` on macOS), but you may find useful to disable this flag working with exotic setup. -* Flag `bmi2`, disabled by default, experimental.-- Depend on `bits-extra` package and use it for `nthBitIndex`.- This is supposed to be faster, but have not been properly polished yet.- ## Similar packages * [`bv`](https://hackage.haskell.org/package/bv) and
bitvec.cabal view
@@ -1,5 +1,5 @@ name: bitvec-version: 1.0.2.0+version: 1.0.3.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -46,7 +46,7 @@ author: Andrew Lelechenko <andrew.lelechenko@gmail.com>, James Cook <mokus@deepbondi.net> -tested-with: GHC ==7.10.3 GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1+tested-with: GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1 GHC ==8.8.2 GHC ==8.8.3 GHC ==8.10.1 extra-source-files: changelog.md README.md@@ -55,10 +55,6 @@ type: git location: git://github.com/Bodigrim/bitvec.git -flag bmi2- description: Enable bmi2 instruction set- default: False- flag integer-gmp description: Use integer-gmp package for binary polynomials default: True@@ -72,14 +68,11 @@ Data.Bit Data.Bit.ThreadSafe build-depends:- base >=4.8 && <5,+ base >=4.9 && <5, deepseq, ghc-prim, primitive >=0.5, vector >=0.11- if (flag(bmi2)) && (impl(ghc >=8.4.1))- build-depends:- bits-extra >=0.0.0.4 && <0.1 if impl(ghc <8.0) build-depends: semigroups >=0.8@@ -95,13 +88,10 @@ Data.Bit.InternalTS Data.Bit.Mutable Data.Bit.MutableTS- Data.Bit.Select1+ Data.Bit.PdepPext Data.Bit.Utils ghc-options: -O2 -Wall include-dirs: src- if flag(bmi2) && impl(ghc >=8.4.1)- ghc-options: -mbmi2 -msse4.2- cpp-options: -DBMI2_ENABLED if flag(integer-gmp) && impl(ghc >=8.0.1) build-depends: integer-gmp cpp-options: -DUseIntegerGmp@@ -113,7 +103,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs build-depends:- base >=4.8 && <5,+ base, bitvec, integer-gmp, primitive >=0.5,
changelog.md view
@@ -1,3 +1,9 @@+# 1.0.3.0++* Add `Bits (Vector Bit)` instance.+* Add `castFromWords8`, `castToWords8`, `cloneToWords8`+ to facilitate interoperation with `ByteString`.+ # 1.0.2.0 * Fix out-of-bounds writes in mutable interface.
src/Data/Bit.hs view
@@ -31,6 +31,10 @@ , castToWords , cloneToWords + , castFromWords8+ , castToWords8+ , cloneToWords8+ -- * Immutable operations , zipBits , invertBits
src/Data/Bit/Immutable.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ #ifndef BITVEC_THREADSAFE module Data.Bit.Immutable #else@@ -13,6 +17,10 @@ , castToWords , cloneToWords + , castFromWords8+ , castToWords8+ , cloneToWords8+ , zipBits , invertBits , selectBits@@ -38,12 +46,14 @@ import Data.Bit.InternalTS import Data.Bit.MutableTS #endif-import Data.Bit.Select1+import Data.Bit.PdepPext import Data.Bit.Utils import Data.Primitive.ByteArray import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU+import Data.Word+import Unsafe.Coerce #include "MachDeps.h" @@ -55,7 +65,57 @@ #error unsupported WORD_SIZE_IN_BITS config #endif --- | Cast a vector of words to a vector of bits.+instance {-# OVERLAPPING #-} Bits (Vector Bit) where+ (.&.) = zipBits (.&.)+ (.|.) = zipBits (.|.)+ xor = zipBits xor+ complement = invertBits+ bitSize _ = error "bitSize is undefined"+ bitSizeMaybe _ = Nothing+ isSigned _ = False+ zeroBits = U.empty+ popCount = countBits++ testBit v n+ | n < 0 || n >= U.length v = False+ | otherwise = unBit (U.unsafeIndex v n)++ bit n+ | n < 0 = U.empty+ | otherwise = runST $ do+ v <- MU.replicate (n + 1) (Bit False)+ MU.unsafeWrite v n (Bit True)+ U.unsafeFreeze v++ shift v n = case n `compare` 0 of+ -- shift right+ LT+ | U.length v + n < 0 -> U.empty+ | otherwise -> runST $ do+ u <- MU.new (U.length v + n)+ U.copy u (U.drop (- n) v)+ U.unsafeFreeze u+ -- do not shift+ EQ -> v+ -- shift left+ GT -> runST $ do+ u <- MU.new (U.length v + n)+ MU.set (MU.take n u) (Bit False)+ U.copy (MU.drop n u) v+ U.unsafeFreeze u++ rotate v n'+ | U.null v = v+ | otherwise = runST $ do+ let l = U.length v+ n = n' `mod` l+ u <- MU.new l+ U.copy (MU.drop n u) (U.take (l - n) v)+ U.copy (MU.take n u) (U.drop (l - n) v)+ U.unsafeFreeze u++-- | Cast an unboxed vector of words+-- to an unboxed vector of bits. -- Cf. 'Data.Bit.castFromWordsM'. -- -- >>> castFromWords (Data.Vector.Unboxed.singleton 123)@@ -65,7 +125,8 @@ where P.Vector off len arr = toPrimVector ws --- | Try to cast a vector of bits to a vector of words.+-- | Try to cast an unboxed vector of bits+-- to an unboxed vector of words. -- It succeeds if a vector of bits is aligned. -- Use 'cloneToWords' otherwise. -- Cf. 'Data.Bit.castToWordsM'.@@ -78,8 +139,10 @@ | otherwise = Nothing --- | Clone a vector of bits to a new unboxed vector of words.--- If the bits don't completely fill the words, the last word will be zero-padded.+-- | Clone an unboxed vector of bits+-- to a new unboxed vector of words.+-- If the bits don't completely fill the words,+-- the last word will be zero-padded. -- Cf. 'Data.Bit.cloneToWordsM'. -- -- >>> cloneToWords (read "[1,1,0,1,1,1,1,0]")@@ -91,6 +154,52 @@ U.unsafeFreeze w {-# INLINE cloneToWords #-} +-- | Cast a unboxed vector of 'Word8'+-- to an unboxed vector of bits.+-- This can be used in conjunction+-- with @bytestring-to-vector@ package+-- to convert from 'Data.ByteString.ByteString':+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Vector.Storable.ByteString+-- >>> castFromWords8 (Data.Vector.convert (byteStringToVector "abc"))+-- [1,0,0,0,0,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,0,1,1,0]+castFromWords8 :: U.Vector Word8 -> U.Vector Bit+castFromWords8 ws = BitVec (off `shiftL` 3) (len `shiftL` 3) arr+ where+ P.Vector off len arr = unsafeCoerce ws++-- | Try to cast an unboxed vector of bits+-- to an unboxed vector of 'Word8'.+-- It succeeds if a vector of bits is aligned.+-- Use 'Data.Bit.cloneToWords8' otherwise.+--+-- prop> castToWords8 (castFromWords8 v) == Just v+castToWords8 :: U.Vector Bit -> Maybe (U.Vector Word8)+castToWords8 (BitVec s n ws)+ | s .&. 7 == 0, n .&. 7 == 0 =+ Just $ unsafeCoerce $ P.Vector (s `shiftR` 3) (n `shiftR` 3) ws+ | otherwise = Nothing++-- | Clone an unboxed vector of bits+-- to a new unboxed vector of 'Word8'.+-- If the bits don't completely fill the words,+-- the last 'Word8' will be zero-padded.+-- This can be used in conjunction+-- with @bytestring-to-vector@ package+-- to convert to 'Data.ByteString.ByteString':+--+-- >>> :set -XOverloadedLists+-- >>> import Data.Vector.Storable.ByteString+-- >>> vectorToByteString (Data.Vector.convert (Data.Bit.cloneToWords8 [1,0,0,0,0,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,0,1]))+-- "ab#"+cloneToWords8 :: U.Vector Bit -> U.Vector Word8+cloneToWords8 v = runST $ do+ v' <- U.unsafeThaw v+ w <- cloneToWords8M v'+ U.unsafeFreeze w+{-# INLINE cloneToWords8 #-}+ -- | Zip two vectors with the given function. -- Similar to 'Data.Vector.Unboxed.zipWith', -- but up to 1000x (!) faster.@@ -212,6 +321,9 @@ -- -- >>> reverseBits (read "[1,1,0,1,0]") -- [0,1,0,1,1]+--+-- Consider using @vector-rotcev@ package+-- to reverse vectors in O(1) time. reverseBits :: U.Vector Bit -> U.Vector Bit reverseBits xs = runST $ do let n = U.length xs@@ -379,7 +491,7 @@ lWords = nWords (offBits + len) nthInWord :: Bit -> Int -> Word -> Either Int Int-nthInWord (Bit b) k v = if k > c then Left (k - c) else Right (select1 w k - 1)+nthInWord (Bit b) k v = if k > c then Left (k - c) else Right (unsafeNthTrueInWord k w) where w = if b then v else complement v c = popCount w@@ -391,7 +503,7 @@ | n >= off + len = Left l | otherwise = if l > c then go (n + 1) (l - c)- else Right (mulWordSize (n - off) + select1 w l - 1)+ else Right (mulWordSize (n - off) + unsafeNthTrueInWord l w) where w = indexByteArray arr n c = popCount w@@ -401,10 +513,13 @@ | n >= off + len = Left l | otherwise = if l > c then go (n + 1) (l - c)- else Right (mulWordSize (n - off) + select1 w l - 1)+ else Right (mulWordSize (n - off) + unsafeNthTrueInWord l w) where w = complement (indexByteArray arr n) c = popCount w++unsafeNthTrueInWord :: Int -> Word -> Int+unsafeNthTrueInWord l w = countTrailingZeros (pdep (1 `shiftL` (l - 1)) w) -- | Return the number of set bits in a vector (population count, popcount). --
src/Data/Bit/Mutable.hs view
@@ -14,6 +14,8 @@ , castToWordsM , cloneToWordsM + , cloneToWords8M+ , zipInPlace , invertInPlace@@ -37,6 +39,7 @@ import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU+import Data.Word -- | Cast a vector of words to a vector of bits. -- Cf. 'Data.Bit.castFromWords'.@@ -71,6 +74,22 @@ pure $ MU.MV_Word $ P.MVector 0 lenWords arr {-# INLINE cloneToWordsM #-} +-- | Clone a vector of bits to a new unboxed vector of 'Word8'.+-- If the bits don't completely fill the words, the last 'Word8' will be zero-padded.+-- Cf. 'Data.Bit.cloneToWords8'.+cloneToWords8M+ :: PrimMonad m+ => MVector (PrimState m) Bit+ -> m (MVector (PrimState m) Word8)+cloneToWords8M v = do+ let lenBits = MU.length v+ lenWords = (lenBits + 7) `shiftR` 3+ w@(BitMVec _ _ arr) <- MU.unsafeNew (lenWords `shiftL` 3)+ MU.unsafeCopy (MU.slice 0 lenBits w) v+ MU.set (MU.slice lenBits (lenWords `shiftL` 3 - lenBits) w) (Bit False)+ pure $ MU.MV_Word8 $ P.MVector 0 lenWords arr+{-# INLINE cloneToWords8M #-}+ -- | Zip two vectors with the given function. -- rewriting contents of the second argument. -- Cf. 'Data.Bit.zipBits'.@@ -175,7 +194,7 @@ -- | Same as 'Data.Bit.selectBits', but deposit -- selected bits in-place. Returns a number of selected bits.--- It is caller's resposibility to trim the result to this number.+-- It is caller's responsibility to trim the result to this number. selectBitsInPlace :: PrimMonad m => U.Vector Bit -> U.MVector (PrimState m) Bit -> m Int selectBitsInPlace is xs = loop 0 0@@ -191,7 +210,7 @@ -- | Same as 'Data.Bit.excludeBits', but deposit -- excluded bits in-place. Returns a number of excluded bits.--- It is caller's resposibility to trim the result to this number.+-- It is caller's responsibility to trim the result to this number. excludeBitsInPlace :: PrimMonad m => U.Vector Bit -> U.MVector (PrimState m) Bit -> m Int excludeBitsInPlace is xs = loop 0 0@@ -210,6 +229,9 @@ -- -- >>> Data.Vector.Unboxed.modify reverseInPlace (read "[1,1,0,1,0]") -- [0,1,0,1,1]+--+-- Consider using @vector-rotcev@ package+-- to reverse vectors in O(1) time. reverseInPlace :: PrimMonad m => U.MVector (PrimState m) Bit -> m () reverseInPlace xs | len == 0 = pure () | otherwise = loop 0
+ src/Data/Bit/PdepPext.hs view
@@ -0,0 +1,54 @@+-- |+-- Module: Data.Bit.PdepPext+-- Copyright: (c) 2020 Andrew Lelechenko+-- Licence: BSD3+--+-- | Parallel bit deposit and extract instructions.+-- https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract++{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module Data.Bit.PdepPext+ ( pdep+ , pext+ ) where++#if MIN_VERSION_base(4,11,0)++import GHC.Exts++pdep :: Word -> Word -> Word+pdep (W# src#) (W# mask#) = W# (pdep# src# mask#)++pext :: Word -> Word -> Word+pext (W# src#) (W# mask#) = W# (pext# src# mask#)++#else++import Data.Bits++pdep :: Word -> Word -> Word+pdep = go 0+ where+ go :: Word -> Word -> Word -> Word+ go result _ 0 = result+ go result src mask = go newResult newSrc newMask+ where+ lowest = 1 `shiftL` countTrailingZeros mask+ newResult = if src .&. 1 == 0 then result else result .|. lowest+ newSrc = src `shiftR` 1+ newMask = mask .&. complement lowest++pext :: Word -> Word -> Word+pext src mask = loop 0 0 0+ where+ loop i count acc+ | i >= finiteBitSize (0 :: Word)+ = acc+ | testBit mask i+ = loop (i + 1) (count + 1) (if testBit src i then setBit acc count else acc)+ | otherwise+ = loop (i + 1) count acc++#endif
− src/Data/Bit/Select1.hs
@@ -1,149 +0,0 @@--- |--- Module: Data.Bit.Select1--- Copyright: (c) 2016 John Ky--- Licence: BSD3------ This is a modification of "HaskellWorks.Data.RankSelect.Base.Internal"--- from hw-rankselect-base package.--{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}-#endif--module Data.Bit.Select1- ( select1- ) where--#include "MachDeps.h"--import Data.Bits-#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)-import Data.Bits.Pdep-import Data.Int-#endif-import Data.Word--infixl 8 .>.-(.>.) :: Bits a => a -> Int -> a-(.>.) = shiftR--infixl 8 .<.-(.<.) :: Bits a => a -> Int -> a-(.<.) = shiftL--#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)--select1Word64Bmi2Base0 :: Word64 -> Word64 -> Word64-select1Word64Bmi2Base0 w r = fromIntegral (countTrailingZeros (pdep (1 .<. fromIntegral r) w))-{-# INLINE select1Word64Bmi2Base0 #-}--select1Word64Bmi2 :: Word64 -> Word64 -> Word64-select1Word64Bmi2 w r =- let zeros = countTrailingZeros (pdep (1 .<. fromIntegral (r - 1)) w) :: Int- mask = fromIntegral ((fromIntegral (zeros .<. 57) :: Int64) `shiftR` 63) :: Word64- in (fromIntegral zeros .|. mask) + 1-{-# INLINE select1Word64Bmi2 #-}--select1Word32Bmi2 :: Word32 -> Word64 -> Word64-select1Word32Bmi2 w r =- let zeros = countTrailingZeros (pdep (1 .<. fromIntegral (r - 1)) w) :: Int- mask = fromIntegral ((fromIntegral (zeros .<. 58) :: Int64) `shiftR` 63) :: Word64- in (fromIntegral zeros .|. mask) + 1-{-# INLINE select1Word32Bmi2 #-}--#endif--select1Word64Broadword :: Word64 -> Word64 -> Word64-select1Word64Broadword _ 0 = 0-select1Word64Broadword v rn =- -- Do a normal parallel bit count for a 64-bit integer,- -- but store all intermediate steps.- let a = (v .&. 0x5555555555555555) + ((v .>. 1) .&. 0x5555555555555555) in- let b = (a .&. 0x3333333333333333) + ((a .>. 2) .&. 0x3333333333333333) in- let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f0f0f0f0f) in- let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>. 8) .&. 0x00ff00ff00ff00ff) in- let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff) in- let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff) in- -- Now do branchless select!- let r0 = f + 1 - fromIntegral rn in- let s0 = 64 :: Word64 in- let t0 = (d .>. 32) + (d .>. 48) in- let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in- let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in- let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in- let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in- let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in- let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in- let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in- let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in- let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in- let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in- let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in- let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in- let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in- let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in- let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in- let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in- fromIntegral s6-{-# INLINE select1Word64Broadword #-}--select1Word32Broadword :: Word32 -> Word64 -> Word64-select1Word32Broadword _ 0 = 0-select1Word32Broadword v rn =- -- Do a normal parallel bit count for a 64-bit integer,- -- but store all intermediate steps.- let a = (v .&. 0x55555555) + ((v .>. 1) .&. 0x55555555) in- let b = (a .&. 0x33333333) + ((a .>. 2) .&. 0x33333333) in- let c = (b .&. 0x0f0f0f0f) + ((b .>. 4) .&. 0x0f0f0f0f) in- let d = (c .&. 0x00ff00ff) + ((c .>. 8) .&. 0x00ff00ff) in- let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff) in- -- Now do branchless select!- let r0 = e + 1 - fromIntegral rn in- let s0 = 64 :: Word32 in- let t0 = (d .>. 32) + (d .>. 48) in- let s1 = s0 - ((t0 - r0) .&. 256) .>. 3 in- let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8)) in- let t1 = (d .>. fromIntegral (s1 - 16)) .&. 0xff in- let s2 = s1 - ((t1 - r1) .&. 256) .>. 4 in- let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8)) in- let t2 = (c .>. fromIntegral (s2 - 8)) .&. 0xf in- let s3 = s2 - ((t2 - r2) .&. 256) .>. 5 in- let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8)) in- let t3 = (b .>. fromIntegral (s3 - 4)) .&. 0x7 in- let s4 = s3 - ((t3 - r3) .&. 256) .>. 6 in- let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8)) in- let t4 = (a .>. fromIntegral (s4 - 2)) .&. 0x3 in- let s5 = s4 - ((t4 - r4) .&. 256) .>. 7 in- let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8)) in- let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in- let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in- fromIntegral s6-{-# INLINE select1Word32Broadword #-}--select1Word64 :: Word64 -> Word64 -> Word64-#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)-select1Word64 = select1Word64Bmi2-#else-select1Word64 = select1Word64Broadword-#endif-{-# INLINE select1Word64 #-}--select1Word32 :: Word32 -> Word64 -> Word64-#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)-select1Word32 = select1Word32Bmi2-#else-select1Word32 = select1Word32Broadword-#endif-{-# INLINE select1Word32 #-}--select1 :: Word -> Int -> Int-#if WORD_SIZE_IN_BITS == 64-select1 w i = fromIntegral $ select1Word64 (fromIntegral w) (fromIntegral i)-#elif WORD_SIZE_IN_BITS == 32-select1 w i = fromIntegral $ select1Word32 (fromIntegral w) (fromIntegral i)-#else-#error unsupported WORD_SIZE_IN_BITS config-#endif-{-# INLINE select1 #-}
src/Data/Bit/Utils.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} module Data.Bit.Utils ( lgWordSize@@ -29,8 +30,13 @@ import Data.Bits import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U+#if __GLASGOW_HASKELL__ >= 810+import GHC.Exts+#endif import Unsafe.Coerce +import Data.Bit.PdepPext+ -- |The number of bits in a 'Word'. A handy constant to have around when defining 'Word'-based bulk operations on bit vectors. wordSize :: Int wordSize = finiteBitSize (0 :: Word)@@ -95,8 +101,11 @@ meld b lo hi = (lo .&. m) .|. (hi .&. complement m) where m = mask b {-# INLINE meld #-} -#if WORD_SIZE_IN_BITS == 64+#if __GLASGOW_HASKELL__ >= 810 reverseWord :: Word -> Word+reverseWord (W# w#) = W# (bitReverse# w#)+#elif WORD_SIZE_IN_BITS == 64+reverseWord :: Word -> Word reverseWord x0 = x6 where x1 = ((x0 .&. 0x5555555555555555) `shiftL` 1) .|. ((x0 .&. 0xAAAAAAAAAAAAAAAA) `shiftR` 1)@@ -128,14 +137,8 @@ {-# INLINE ffs #-} selectWord :: Word -> Word -> (Int, Word)-selectWord m x = loop 0 0 0- where- loop !i !ct !y- | i >= wordSize = (ct, y)- | testBit m i = loop (i + 1)- (ct + 1)- (if testBit x i then setBit y ct else y)- | otherwise = loop (i + 1) ct y+selectWord msk src = (popCount msk, pext src msk)+{-# INLINE selectWord #-} #if WORD_SIZE_IN_BITS == 64
test/Support.hs view
@@ -91,20 +91,20 @@ wordSize :: Int wordSize = finiteBitSize (0 :: Word) -packBitsToWord :: [Bit] -> (Word, [Bit])-packBitsToWord = loop 0 0+packBitsToWord :: FiniteBits a => [Bit] -> (a, [Bit])+packBitsToWord = loop 0 zeroBits where loop _ w [] = (w, []) loop i w (x : xs)- | i >= wordSize = (w, x : xs)- | otherwise = loop (i + 1) (if unBit x then setBit w i else w) xs+ | i >= finiteBitSize w = (w, x : xs)+ | otherwise = loop (i + 1) (if unBit x then setBit w i else w) xs readWordL :: [Bit] -> Int -> Word readWordL xs 0 = fst (packBitsToWord xs) readWordL xs n = readWordL (drop n xs) 0 -wordToBitList :: Word -> [Bit]-wordToBitList w = [ Bit (testBit w i) | i <- [0 .. wordSize - 1] ]+wordToBitList :: FiniteBits a => a -> [Bit]+wordToBitList w = [ Bit (testBit w i) | i <- [0 .. finiteBitSize w - 1] ] writeWordL :: [Bit] -> Int -> Word -> [Bit] writeWordL xs 0 w = zipWith const (wordToBitList w) xs ++ drop wordSize xs
test/Tests/Vector.hs view
@@ -4,8 +4,10 @@ import Prelude hiding (and, or) import Data.Bit+import Data.Bits import Data.List hiding (and, or) import qualified Data.Vector.Unboxed as U hiding (reverse, and, or, any, all, findIndex)+import Data.Word import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck@@ -20,6 +22,9 @@ , tenTimesLess $ testProperty "cloneFromWords" prop_cloneFromWords_def , testProperty "cloneToWords" prop_cloneToWords_def+ , tenTimesLess $+ testProperty "cloneFromWords8" prop_cloneFromWords8_def+ , testProperty "cloneToWords8" prop_cloneToWords8_def , testProperty "reverse" prop_reverse_def , testProperty "countBits" prop_countBits_def , testProperty "listBits" prop_listBits_def@@ -38,6 +43,12 @@ , testProperty "matches sequence of bitIndex False" prop_nthBit_4 , testProperty "matches countBits" prop_nthBit_5 ]+ , testGroup "Bits instance"+ [ testProperty "rotate is reversible" prop_rotate+ , testProperty "bit" prop_bit+ , testProperty "shiftL" prop_shiftL+ , testProperty "shiftR" prop_shiftR+ ] ] prop_toList_fromList :: [Bit] -> Bool@@ -62,6 +73,17 @@ loop bs = case packBitsToWord bs of (w, bs') -> w : loop bs' +prop_cloneFromWords8_def :: U.Vector Word8 -> Property+prop_cloneFromWords8_def ws =+ U.toList (castFromWords8 ws) === concatMap wordToBitList (U.toList ws)++prop_cloneToWords8_def :: U.Vector Bit -> Bool+prop_cloneToWords8_def xs = U.toList (cloneToWords8 xs) == loop (U.toList xs)+ where+ loop [] = []+ loop bs = case packBitsToWord bs of+ (w, bs') -> w : loop bs'+ prop_reverse_def :: U.Vector Bit -> Bool prop_reverse_def xs = reverse (U.toList xs) == U.toList (U.modify reverseInPlace xs)@@ -131,3 +153,22 @@ $ nthBitIndex (Bit True) 1 $ U.slice 61 4 $ U.replicate 100 (Bit False)++prop_rotate :: Int -> U.Vector Bit -> Property+prop_rotate n v = v === (v `rotate` n) `rotate` (-n)++prop_bit :: NonNegative Int -> Property+prop_bit (NonNegative n) = testBit v n .&&. popCount v === 1 .&&. U.length v == n + 1+ where+ v :: U.Vector Bit+ v = bit n++prop_shiftL :: NonNegative Int -> U.Vector Bit -> Property+prop_shiftL (NonNegative n) v = v === u+ where+ u = (v `shiftL` n) `shiftR` n++prop_shiftR :: NonNegative Int -> U.Vector Bit -> Property+prop_shiftR (NonNegative n) v = U.drop n v === U.drop n u .&&. popCount (U.take n u) === 0+ where+ u = (v `shiftR` n) `shiftL` n