Bump actions/cache from 2.1.5 to 2.1.6

.github/workflows/ci.yml

@@ -13,7 +13,7 @@ jobs:
     - uses: actions/checkout@v2
     - name: Build
       id: build-FreeBSD
-      uses: vmactions/freebsd-vm@v0.0.9
+      uses: vmactions/freebsd-vm@v0.1.4
       with:
         usesh: true
         prepare: pkg install -y ghc hs-cabal-install autoconf git
@@ -31,15 +31,15 @@ jobs:
       fail-fast: true
       matrix:
         os: [ubuntu-latest, macOS-latest, windows-latest]
-        ghc: ['8.10', '8.8.4', '8.8.2', '8.8.1', '8.6', '8.4', '8.2', '8.0']
+        ghc: ['9.0', '8.10', '8.8.4', '8.8.2', '8.8.1', '8.6', '8.4', '8.2', '8.0']
     steps:
     - uses: actions/checkout@v2
-    - uses: actions/setup-haskell@v1
+    - uses: haskell/actions/setup@v1
       id: setup-haskell-cabal
       with:
         ghc-version: ${{ matrix.ghc }}
         cabal-version: 'latest'
-    - uses: actions/cache@v2
+    - uses: actions/cache@v2.1.6
       name: Cache cabal stuff
       with:
         path: |

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
@@ -46,7 +46,7 @@ category: Data, Bit Vectors
 author: Andrew Lelechenko <andrew.lelechenko@gmail.com>,
         James Cook <mokus@deepbondi.net>
 
-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.4 GHC ==8.10.2
+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.4 GHC ==8.10.4 GHC ==9.0.1
 extra-source-files:
   changelog.md
   README.md
@@ -87,6 +87,9 @@ library
     Data.Bit.MutableTS
     Data.Bit.PdepPext
     Data.Bit.Utils
+  if flag(libgmp)
+    other-modules:
+      Data.Bit.Gmp
   ghc-options: -O2 -Wall
   include-dirs: src
 
@@ -106,6 +109,7 @@ test-suite bitvec-tests
     base,
     bitvec,
     primitive >=0.5,
+    quickcheck-classes-base,
     quickcheck-classes >=0.6.1,
     vector >=0.11,
     tasty,
@@ -130,14 +134,17 @@ test-suite bitvec-tests
   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

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`.

src/Data/Bit.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_HADDOCK prune #-}
 
 #ifndef BITVEC_THREADSAFE
 -- |
@@ -22,6 +23,8 @@ module Data.Bit
 module Data.Bit.ThreadSafe
 #endif
   ( Bit(..)
+  , U.Vector(BitVec)
+  , U.MVector(BitMVec)
 
   , unsafeFlipBit
   , flipBit
@@ -71,6 +74,7 @@ module Data.Bit.ThreadSafe
   ) where
 
 import Prelude hiding (and, or)
+import qualified Data.Vector.Unboxed as U
 
 #ifndef BITVEC_THREADSAFE
 import Data.Bit.F2Poly

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 Num F2Poly where
 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
 

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 s -> ByteArray -> ByteArray -> Int -> ST s ()
 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

src/Data/Bit/Immutable.hs

@@ -61,14 +61,12 @@ import qualified Data.Vector.Unboxed.Mutable as MU
 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 _ _ (BitVec _ 0 _) = U.empty
 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 @@ invertBits (BitVec _ 0 _) = U.empty
 #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

src/Data/Bit/Internal.hs

@@ -31,7 +31,6 @@ module Data.Bit.InternalTS
 
 import Control.DeepSeq
 import Control.Exception
-import Control.Monad
 import Control.Monad.Primitive
 import Control.Monad.ST
 import Data.Bits
@@ -119,8 +118,8 @@ extendToWord (Bit True ) = complement 0
 
 -- | 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 @@ indexWord !(BitVec off len' arr) !i' = word
   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 @@ modifyByteArray (MutableByteArray mba) (I# ix) (W# msk) (W# new) = do
 
 -- | 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 @@ instance MV.MVector U.MVector Bit where
       | 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 @@ flipBit v i =
 #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

src/Data/Bit/Utils.hs

@@ -25,8 +25,6 @@ module Data.Bit.Utils
   , toPrimVector
   ) where
 
-#include "MachDeps.h"
-
 import Data.Bits
 import qualified Data.Vector.Primitive as P
 import qualified Data.Vector.Unboxed as U
@@ -104,29 +102,37 @@ meld b lo hi = (lo .&. m) .|. (hi .&. complement m) where m = mask b
 {-# 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)
   x3 = ((x2 .&. 0x0F0F0F0F0F0F0F0F) `shiftL`  4) .|. ((x2 .&. 0xF0F0F0F0F0F0F0F0) `shiftR`  4)
   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 :: Word -> Word -> (Int, Word)
 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 @@ sparseBitsInternal x = x4
     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));
@@ -190,10 +196,6 @@ sparseBitsInternal x0 = x4
     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
 {-# INLINE loMask #-}