diff --git a/bitvec.cabal b/bitvec.cabal --- a/bitvec.cabal +++ b/bitvec.cabal @@ -1,6 +1,6 @@ name: bitvec -version: 1.1.0.0 -cabal-version: >=1.10 +version: 1.1.1.0 +cabal-version: 2.0 build-type: Simple license: BSD3 license-file: LICENSE @@ -87,6 +87,9 @@ Data.Bit.MutableTS Data.Bit.PdepPext Data.Bit.Utils + if flag(libgmp) + other-modules: + Data.Bit.Gmp ghc-options: -O2 -Wall include-dirs: src @@ -130,14 +133,17 @@ else build-depends: ghc-bignum -benchmark gauge +benchmark bitvec-bench build-depends: base, bitvec, containers, - gauge, random, vector + build-depends: + tasty-bench + mixins: + tasty-bench (Test.Tasty.Bench as Gauge.Main) type: exitcode-stdio-1.0 main-is: Bench.hs default-language: Haskell2010 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 1.1.1.0 + +* Export `BitVec` and `BitMVec` constructors. + # 1.1.0.0 * Fix a grave bug in `bitIndex`. diff --git a/src/Data/Bit.hs b/src/Data/Bit.hs --- a/src/Data/Bit.hs +++ b/src/Data/Bit.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK prune #-} #ifndef BITVEC_THREADSAFE -- | @@ -22,6 +23,8 @@ module Data.Bit.ThreadSafe #endif ( Bit(..) + , U.Vector(BitVec) + , U.MVector(BitMVec) , unsafeFlipBit , flipBit @@ -71,6 +74,7 @@ ) where import Prelude hiding (and, or) +import qualified Data.Vector.Unboxed as U #ifndef BITVEC_THREADSAFE import Data.Bit.F2Poly diff --git a/src/Data/Bit/F2Poly.hs b/src/Data/Bit/F2Poly.hs --- a/src/Data/Bit/F2Poly.hs +++ b/src/Data/Bit/F2Poly.hs @@ -4,7 +4,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} @@ -134,10 +133,10 @@ instance Enum F2Poly where fromEnum = fromIntegral #ifdef MIN_VERSION_ghc_bignum - toEnum !(I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) + toEnum (I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) $ ByteArray (bigNatFromWord# (int2Word# i#)) #else - toEnum !(I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) + toEnum (I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) $ fromBigNat $ wordToBigNat (int2Word# i#) #endif diff --git a/src/Data/Bit/Gmp.hs b/src/Data/Bit/Gmp.hs --- a/src/Data/Bit/Gmp.hs +++ b/src/Data/Bit/Gmp.hs @@ -1,9 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnliftedFFITypes #-} -#if UseLibGmp - module Data.Bit.Gmp ( mpnCom , mpnPopcount @@ -102,9 +99,3 @@ mpnXnorN (MutableByteArray res#) (ByteArray arg1#) (ByteArray arg2#) (I# limbs#) = unsafeIOToST (mpn_xnor_n res# arg1# arg2# limbs#) {-# INLINE mpnXnorN #-} - -#else - -module Data.Bit.Gmp where - -#endif diff --git a/src/Data/Bit/Immutable.hs b/src/Data/Bit/Immutable.hs --- a/src/Data/Bit/Immutable.hs +++ b/src/Data/Bit/Immutable.hs @@ -61,14 +61,12 @@ import Data.Word import Unsafe.Coerce -#include "MachDeps.h" - -#if WORD_SIZE_IN_BITS == 64 -#define GMP_LIMB_SHIFT 3 -#elif WORD_SIZE_IN_BITS == 32 -#define GMP_LIMB_SHIFT 2 -#else -#error unsupported WORD_SIZE_IN_BITS config +#if UseLibGmp +gmpLimbShift :: Int +gmpLimbShift = case wordSize of + 32 -> 2 + 64 -> 3 + _ -> error "gmpLimbShift: unknown architecture" #endif instance {-# OVERLAPPING #-} Bits (Vector Bit) where @@ -261,7 +259,7 @@ zipBits f (BitVec 0 l1 arg1) (BitVec 0 l2 arg2) = runST $ do let l = l1 `min` l2 w = nWords l - b = w `shiftL` GMP_LIMB_SHIFT + b = w `shiftL` gmpLimbShift brr <- newByteArray b let ff = unBit $ f (Bit False) (Bit False) ft = unBit $ f (Bit False) (Bit True) @@ -328,7 +326,7 @@ #if UseLibGmp invertBits (BitVec 0 l arg) = runST $ do let w = nWords l - brr <- newByteArray (w `shiftL` GMP_LIMB_SHIFT) + brr <- newByteArray (w `shiftL` gmpLimbShift) mpnCom brr arg w BitVec 0 l <$> unsafeFreezeByteArray brr #endif diff --git a/src/Data/Bit/Internal.hs b/src/Data/Bit/Internal.hs --- a/src/Data/Bit/Internal.hs +++ b/src/Data/Bit/Internal.hs @@ -31,7 +31,6 @@ import Control.DeepSeq import Control.Exception -import Control.Monad import Control.Monad.Primitive import Control.Monad.ST import Data.Bits @@ -119,8 +118,8 @@ -- | read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.). If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage. indexWord :: U.Vector Bit -> Int -> Word -indexWord !(BitVec _ 0 _) _ = 0 -indexWord !(BitVec off len' arr) !i' = word +indexWord (BitVec _ 0 _) _ = 0 +indexWord (BitVec off len' arr) !i' = word where len = off + len' i = off + i' @@ -129,19 +128,19 @@ loWord = indexByteArray arr loIx hiWord = indexByteArray arr (loIx + 1) - word = if nMod == 0 - then loWord - else if loIx == divWordSize (len - 1) - then (loWord `unsafeShiftR` nMod) - else - (loWord `unsafeShiftR` nMod) - .|. (hiWord `unsafeShiftL` (wordSize - nMod)) + word + | nMod == 0 + = loWord + | loIx == divWordSize (len - 1) + = loWord `unsafeShiftR` nMod + | otherwise + = (loWord `unsafeShiftR` nMod) .|. (hiWord `unsafeShiftL` (wordSize - nMod)) {-# INLINE indexWord #-} -- | read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.). If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage. readWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m Word -readWord !(BitMVec _ 0 _) _ = pure 0 -readWord !(BitMVec off len' arr) !i' = do +readWord (BitMVec _ 0 _) _ = pure 0 +readWord (BitMVec off len' arr) !i' = do let len = off + len' i = off + i' nMod = modWordSize i @@ -190,8 +189,8 @@ -- | write a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.). If the offset is such that the word extends past the end of the vector, the word is truncated and as many low-order bits as possible are written. writeWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> Word -> m () -writeWord !(BitMVec _ 0 _) _ _ = pure () -writeWord !(BitMVec off len' arr) !i' !x +writeWord (BitMVec _ 0 _) _ _ = pure () +writeWord (BitMVec off len' arr) !i' !x | iMod == 0 = if len >= i + wordSize then writeByteArray arr iDiv x @@ -378,7 +377,7 @@ | otherwise = pure () {-# INLINE basicUnsafeMove #-} - basicUnsafeMove !dst !src@(BitMVec srcShift srcLen _) + basicUnsafeMove !dst src@(BitMVec srcShift srcLen _) | MV.basicOverlaps dst src = do -- Align shifts of src and srcCopy to speed up basicUnsafeCopy srcCopy src srcCopy <- MV.drop (modWordSize srcShift) @@ -483,9 +482,8 @@ #endif instance V.Vector U.Vector Bit where - basicUnsafeFreeze (BitMVec s n v) = - liftM (BitVec s n) (unsafeFreezeByteArray v) - basicUnsafeThaw (BitVec s n v) = liftM (BitMVec s n) (unsafeThawByteArray v) + basicUnsafeFreeze (BitMVec s n v) = BitVec s n <$> unsafeFreezeByteArray v + basicUnsafeThaw (BitVec s n v) = BitMVec s n <$> unsafeThawByteArray v basicLength (BitVec _ n _) = n basicUnsafeIndexM (BitVec off _ arr) !i' = do diff --git a/src/Data/Bit/Utils.hs b/src/Data/Bit/Utils.hs --- a/src/Data/Bit/Utils.hs +++ b/src/Data/Bit/Utils.hs @@ -25,8 +25,6 @@ , toPrimVector ) where -#include "MachDeps.h" - import Data.Bits import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U @@ -104,11 +102,20 @@ {-# INLINE meld #-} #if __GLASGOW_HASKELL__ >= 810 + reverseWord :: Word -> Word reverseWord (W# w#) = W# (bitReverse# w#) -#elif WORD_SIZE_IN_BITS == 64 + +#else + reverseWord :: Word -> Word -reverseWord x0 = x6 +reverseWord = case wordSize of + 32 -> reverseWord32 + 64 -> reverseWord64 + _ -> error "reverseWord: unknown architecture" + +reverseWord64 :: Word -> Word +reverseWord64 x0 = x6 where x1 = ((x0 .&. 0x5555555555555555) `shiftL` 1) .|. ((x0 .&. 0xAAAAAAAAAAAAAAAA) `shiftR` 1) x2 = ((x1 .&. 0x3333333333333333) `shiftL` 2) .|. ((x1 .&. 0xCCCCCCCCCCCCCCCC) `shiftR` 2) @@ -116,17 +123,16 @@ x4 = ((x3 .&. 0x00FF00FF00FF00FF) `shiftL` 8) .|. ((x3 .&. 0xFF00FF00FF00FF00) `shiftR` 8) x5 = ((x4 .&. 0x0000FFFF0000FFFF) `shiftL` 16) .|. ((x4 .&. 0xFFFF0000FFFF0000) `shiftR` 16) x6 = ((x5 .&. 0x00000000FFFFFFFF) `shiftL` 32) .|. ((x5 .&. 0xFFFFFFFF00000000) `shiftR` 32) -#elif WORD_SIZE_IN_BITS == 32 -reverseWord :: Word -> Word -reverseWord x0 = x5 + +reverseWord32 :: Word -> Word +reverseWord32 x0 = x5 where x1 = ((x0 .&. 0x55555555) `shiftL` 1) .|. ((x0 .&. 0xAAAAAAAA) `shiftR` 1) x2 = ((x1 .&. 0x33333333) `shiftL` 2) .|. ((x1 .&. 0xCCCCCCCC) `shiftR` 2) x3 = ((x2 .&. 0x0F0F0F0F) `shiftL` 4) .|. ((x2 .&. 0xF0F0F0F0) `shiftR` 4) x4 = ((x3 .&. 0x00FF00FF) `shiftL` 8) .|. ((x3 .&. 0xFF00FF00) `shiftR` 8) x5 = ((x4 .&. 0x0000FFFF) `shiftL` 16) .|. ((x4 .&. 0xFFFF0000) `shiftR` 16) -#else -#error unsupported WORD_SIZE_IN_BITS config + #endif reversePartialWord :: Int -> Word -> Word @@ -143,18 +149,22 @@ selectWord msk src = (popCount msk, pext src msk) {-# INLINE selectWord #-} -#if WORD_SIZE_IN_BITS == 64 - -- | Insert 0 between each consecutive bits of an input. -- xyzw --> (x0y0, z0w0) sparseBits :: Word -> (Word, Word) -sparseBits w = (x, y) +sparseBits = case wordSize of + 32 -> sparseBits32 + 64 -> sparseBits64 + _ -> error "sparseBits: unknown architecture" + +sparseBits64 :: Word -> (Word, Word) +sparseBits64 w = (x, y) where - x = sparseBitsInternal (w .&. loMask 32) - y = sparseBitsInternal (w `shiftR` 32) + x = sparseBitsInternal64 (w .&. loMask 32) + y = sparseBitsInternal64 (w `shiftR` 32) -sparseBitsInternal :: Word -> Word -sparseBitsInternal x = x4 +sparseBitsInternal64 :: Word -> Word +sparseBitsInternal64 x = x4 where t = (x `xor` (x `shiftR` 16)) .&. 0x00000000ffff0000 x0 = x `xor` (t `xor` (t `shiftL` 16)); @@ -168,18 +178,14 @@ t3 = (x3 `xor` (x3 `shiftR` 1)) .&. 0x2222222222222222; x4 = x3 `xor` (t3 `xor` (t3 `shiftL` 1)); -#elif WORD_SIZE_IN_BITS == 32 - --- | Insert 0 between each consecutive bits of an input. --- xyzw --> (x0y0, z0w0) -sparseBits :: Word -> (Word, Word) -sparseBits w = (x, y) +sparseBits32 :: Word -> (Word, Word) +sparseBits32 w = (x, y) where - x = sparseBitsInternal (w .&. loMask 16) - y = sparseBitsInternal (w `shiftR` 16) + x = sparseBitsInternal32 (w .&. loMask 16) + y = sparseBitsInternal32 (w `shiftR` 16) -sparseBitsInternal :: Word -> Word -sparseBitsInternal x0 = x4 +sparseBitsInternal32 :: Word -> Word +sparseBitsInternal32 x0 = x4 where t0 = (x0 `xor` (x0 `shiftR` 8)) .&. 0x0000ff00; x1 = x0 `xor` (t0 `xor` (t0 `shiftL` 8)); @@ -189,10 +195,6 @@ x3 = x2 `xor` (t2 `xor` (t2 `shiftL` 2)); t3 = (x3 `xor` (x3 `shiftR` 1)) .&. 0x22222222; x4 = x3 `xor` (t3 `xor` (t3 `shiftL` 1)); - -#else -#error unsupported WORD_SIZE_IN_BITS config -#endif loMask :: Int -> Word loMask n = 1 `unsafeShiftL` n - 1