summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBodigrim <>2020-03-25 22:22:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-03-25 22:22:00 (GMT)
commit433ea556cfa52abd4482eba92dfe610464699291 (patch)
tree9f3c2fffb13e728e822f393cfc13644e444b1a1b
parent45bbacbd1cc9049ce005cf7ab8c49a2b542807c8 (diff)
version 1.0.3.0HEAD1.0.3.0master
-rw-r--r--README.md5
-rw-r--r--bitvec.cabal20
-rw-r--r--changelog.md6
-rw-r--r--src/Data/Bit.hs4
-rw-r--r--src/Data/Bit/Immutable.hs139
-rw-r--r--src/Data/Bit/Mutable.hs26
-rw-r--r--src/Data/Bit/PdepPext.hs54
-rw-r--r--src/Data/Bit/Select1.hs149
-rw-r--r--src/Data/Bit/Utils.hs21
-rw-r--r--test/Support.hs12
-rw-r--r--test/Tests/Vector.hs41
11 files changed, 279 insertions, 198 deletions
diff --git a/README.md b/README.md
index f928980..20e12bc 100644
--- a/README.md
+++ b/README.md
@@ -161,11 +161,6 @@ Disabling them does not diminish `bitvec`'s capabilities, but makes certain oper
(`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
diff --git a/bitvec.cabal b/bitvec.cabal
index e324ddb..ae891e5 100644
--- a/bitvec.cabal
+++ b/bitvec.cabal
@@ -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 @@ category: Data, Bit Vectors
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 @@ source-repository head
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 @@ library
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 @@ library
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 @@ test-suite bitvec-tests
type: exitcode-stdio-1.0
main-is: Main.hs
build-depends:
- base >=4.8 && <5,
+ base,
bitvec,
integer-gmp,
primitive >=0.5,
diff --git a/changelog.md b/changelog.md
index 0f4c35f..2758fa1 100644
--- a/changelog.md
+++ b/changelog.md
@@ -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.
diff --git a/src/Data/Bit.hs b/src/Data/Bit.hs
index 18f8860..82e5073 100644
--- a/src/Data/Bit.hs
+++ b/src/Data/Bit.hs
@@ -31,6 +31,10 @@ module Data.Bit.ThreadSafe
, castToWords
, cloneToWords
+ , castFromWords8
+ , castToWords8
+ , cloneToWords8
+
-- * Immutable operations
, zipBits
, invertBits
diff --git a/src/Data/Bit/Immutable.hs b/src/Data/Bit/Immutable.hs
index 2964609..6c5e0fb 100644
--- a/src/Data/Bit/Immutable.hs
+++ b/src/Data/Bit/Immutable.hs
@@ -1,8 +1,12 @@
-{-# 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
@@ -13,6 +17,10 @@ module Data.Bit.ImmutableTS
, castToWords
, cloneToWords
+ , castFromWords8
+ , castToWords8
+ , cloneToWords8
+
, zipBits
, invertBits
, selectBits
@@ -38,12 +46,14 @@ import Data.Bit.Mutable
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 @@ import qualified Data.Vector.Unboxed.Mutable as MU
#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 @@ castFromWords ws = BitVec (mulWordSize off) (mulWordSize len) arr
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 @@ castToWords (BitVec s n ws)
| 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 @@ cloneToWords v = runST $ do
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 @@ excludeBits is xs = runST $ do
--
-- >>> 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 @@ nthBitIndex b k (BitVec off len arr)
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 @@ nthInWords (Bit True) !k !off !len !arr = go off k
| 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,11 +513,14 @@ nthInWords (Bit False) !k !off !len !arr = go off k
| 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).
--
-- >>> countBits (read "[1,1,0,1,0,1]")
diff --git a/src/Data/Bit/Mutable.hs b/src/Data/Bit/Mutable.hs
index 5a8795f..66936af 100644
--- a/src/Data/Bit/Mutable.hs
+++ b/src/Data/Bit/Mutable.hs
@@ -14,6 +14,8 @@ module Data.Bit.MutableTS
, castToWordsM
, cloneToWordsM
+ , cloneToWords8M
+
, zipInPlace
, invertInPlace
@@ -37,6 +39,7 @@ 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
-- | Cast a vector of words to a vector of bits.
-- Cf. 'Data.Bit.castFromWords'.
@@ -71,6 +74,22 @@ cloneToWordsM v = do
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 @@ invertInPlace xs = do
-- | 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 @@ selectBitsInPlace is xs = loop 0 0
-- | 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 @@ excludeBitsInPlace is xs = loop 0 0
--
-- >>> 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
diff --git a/src/Data/Bit/PdepPext.hs b/src/Data/Bit/PdepPext.hs
new file mode 100644
index 0000000..d1c00fe
--- /dev/null
+++ b/src/Data/Bit/PdepPext.hs
@@ -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
diff --git a/src/Data/Bit/Select1.hs b/src/Data/Bit/Select1.hs
deleted file mode 100644
index de10cff..0000000
--- a/src/Data/Bit/Select1.hs
+++ /dev/null
@@ -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 #-}
diff --git a/src/Data/Bit/Utils.hs b/src/Data/Bit/Utils.hs
index d4e6b85..f3bb891 100644
--- a/src/Data/Bit/Utils.hs
+++ b/src/Data/Bit/Utils.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
module Data.Bit.Utils
( lgWordSize
@@ -29,8 +30,13 @@ module Data.Bit.Utils
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,7 +101,10 @@ meld :: Int -> Word -> Word -> Word
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
@@ -128,14 +137,8 @@ ffs x = Just $! (popCount (x `xor` complement (-x)) - 1)
{-# 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
diff --git a/test/Support.hs b/test/Support.hs
index 4db12e3..d41d074 100644
--- a/test/Support.hs
+++ b/test/Support.hs
@@ -91,20 +91,20 @@ sliceList s n = take n . drop s
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
diff --git a/test/Tests/Vector.hs b/test/Tests/Vector.hs
index 0e16be3..a4f4675 100644
--- a/test/Tests/Vector.hs
+++ b/test/Tests/Vector.hs
@@ -4,8 +4,10 @@ import Support
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 @@ vectorTests = testGroup "Data.Vector.Unboxed.Bit"
, 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 @@ vectorTests = testGroup "Data.Vector.Unboxed.Bit"
, 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 @@ prop_cloneToWords_def xs = U.toList (cloneToWords xs) == loop (U.toList xs)
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 @@ case_nthBit_1 =
$ 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