packages feed

bitvec 1.0.1.2 → 1.0.2.0

raw patch · 13 files changed

+291/−110 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.Bit: gcdExt :: F2Poly -> F2Poly -> (F2Poly, F2Poly)
+ Data.Bit.ThreadSafe: gcdExt :: F2Poly -> F2Poly -> (F2Poly, F2Poly)

Files

bench/Bench.hs view
@@ -3,6 +3,7 @@ import Gauge.Main  import Bench.BitIndex+import Bench.GCD import Bench.Intersection import Bench.Invert import Bench.Product@@ -18,6 +19,7 @@ main = defaultMain   [ bgroup "bitIndex"     $ map benchBitIndex     [5..14]   , bgroup "invert"       $ map benchInvert       [5..14]+  , bgroup "gcdExt"       $ map benchGCD          [5..14]   , bgroup "intersection" $ map benchIntersection [5..14]   , bgroup "product"      $ map benchProduct      [5..14]   , bgroup "randomWrite"  $ map benchRandomWrite  [5..14]
+ bench/Bench/GCD.hs view
@@ -0,0 +1,30 @@+module Bench.GCD+  ( benchGCD+  ) where++import Data.Bit+import qualified Data.Bit.ThreadSafe as TS+import Data.Bits+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU+import Gauge.Main+import System.Random++randomBools :: [Bool]+randomBools = map (> (0 :: Int)) $ randoms $ mkStdGen $ 42++randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a+randomVec f k = U.fromList $ map f $ take n $ randomBools+  where+    n = 1 `shiftL` k++randomVec' :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a+randomVec' f k = U.fromList $ map f $ take n $ drop n $ randomBools+  where+    n = 1 `shiftL` k++benchGCD :: Int -> Benchmark+benchGCD k = bgroup (show (1 `shiftL` k :: Int))+  [ bench "Bit/gcdExt"    $ nf (uncurry    gcdExt) (   toF2Poly $ randomVec    Bit k,    toF2Poly $ randomVec'    Bit k)+  , bench "Bit.TS/gcdExt" $ nf (uncurry TS.gcdExt) (TS.toF2Poly $ randomVec TS.Bit k, TS.toF2Poly $ randomVec' TS.Bit k)+  ]
bitvec.cabal view
@@ -1,5 +1,5 @@ name: bitvec-version: 1.0.1.2+version: 1.0.2.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -129,9 +129,11 @@   hs-source-dirs: test   other-modules:     Support+    Tests.Conc     Tests.MVector     Tests.MVectorTS     Tests.SetOps+    Tests.SetOpsTS     Tests.Vector   ghc-options: -Wall -threaded -rtsopts   include-dirs: test@@ -151,6 +153,7 @@   hs-source-dirs: bench   other-modules:     Bench.BitIndex+    Bench.GCD     Bench.Invert     Bench.Intersection     Bench.Product
changelog.md view
@@ -1,10 +1,17 @@+# 1.0.2.0++* Fix out-of-bounds writes in mutable interface.+* Improve thread-safety of mutable interface.+* Add extended GCD for `F2Poly`.+* Change `Show` instance of `F2Poly`.+ # 1.0.1.2 -* Fix more bugs in 'F2Poly' multiplication.+* Fix more bugs in `F2Poly` multiplication.  # 1.0.1.1 -* Fix bugs in 'F2Poly' multiplication.+* Fix bugs in `F2Poly` multiplication. * Performance improvements.  # 1.0.1.0@@ -22,18 +29,18 @@  * Redesign API from the scratch. * Add a thread-safe implementation.-* Add 'nthBitIndex' function.+* Add `nthBitIndex` function.  # 0.2.0.1 -* Fix 'Read' instance.+* Fix `Read` instance.  # 0.2.0.0 -* Remove hand-written 'Num', 'Real', 'Integral', 'Bits' instances.-* Derive 'Bits' and 'FiniteBits' instances.-* Expose 'Bit' constructor directly and remove 'fromBool' function.-* Rename 'toBool' to 'unBit'.+* Remove hand-written `Num`, `Real`, `Integral`, `Bits` instances.+* Derive `Bits` and `FiniteBits` instances.+* Expose `Bit` constructor directly and remove `fromBool` function.+* Rename `toBool` to `unBit`.  # 0.1.1.0
src/Data/Bit.hs view
@@ -58,6 +58,7 @@   , F2Poly   , unF2Poly   , toF2Poly+  , gcdExt   ) where  import Prelude hiding (and, or)
src/Data/Bit/F2Poly.hs view
@@ -16,6 +16,7 @@   ( F2Poly   , unF2Poly   , toF2Poly+  , gcdExt   ) where  import Control.DeepSeq@@ -33,12 +34,14 @@ #endif import Data.Bit.Utils import Data.Bits+import Data.Char import Data.Coerce import Data.Primitive.ByteArray import Data.Typeable import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Generics+import Numeric  #if UseIntegerGmp import qualified Data.Vector.Primitive as P@@ -59,13 +62,13 @@ -- >>> :set -XBinaryLiterals -- >>> -- (1 + x) (1 + x + x^2) = 1 + x^3 (mod 2) -- >>> 0b11 * 0b111 :: F2Poly--- F2Poly {unF2Poly = [1,0,0,1]}+-- 0b1001 newtype F2Poly = F2Poly {   unF2Poly :: U.Vector Bit   -- ^ Convert 'F2Poly' to a vector of coefficients   -- (first element corresponds to a constant term).   }-  deriving (Eq, Ord, Show, Typeable, Generic, NFData)+  deriving (Eq, Ord, Typeable, Generic, NFData)  -- | Make 'F2Poly' from a list of coefficients -- (first element corresponds to a constant term).@@ -131,6 +134,9 @@   divMod = quotRem   mod = rem +instance Show F2Poly where+  show = (:) '0' . (:) 'b' . flip (showIntAtBase 2 intToDigit) "" . toInteger+ -- | Inputs must be valid for wrapping into F2Poly: no trailing garbage is allowed. xorBits   :: U.Vector Bit@@ -309,3 +315,20 @@ bitsToInteger = U.ifoldl' (\acc i (Bit b) -> if b then acc `setBit` i else acc) 0  #endif++-- | Execute the extended Euclidean algorithm.+-- For polynomials @a@ and @b@, compute their unique greatest common divisor @g@+-- and the unique coefficient polynomial @s@ satisfying @as + bt = g@.+--+-- >>> :set -XBinaryLiterals+-- >>> gcdExt 0b101 0b0101+-- (0b101,0b0)+-- >>> gcdExt 0b11 0b111+-- (0b1,0b10)+gcdExt :: F2Poly -> F2Poly -> (F2Poly, F2Poly)+gcdExt = go 1 0+  where+    go s s' r r'+      | r' == 0   = (r, s)+      | otherwise = case quotRem r r' of+        (q, r'') -> go s' (s - q * s') r' r''
src/Data/Bit/Internal.hs view
@@ -25,6 +25,7 @@   , unsafeFlipBit   , flipBit   , WithInternals(..)+  , modifyByteArray   ) where  #include "vector.h"@@ -182,45 +183,63 @@ #endif {-# INLINE readWord #-} +modifyByteArray+  :: PrimMonad m+  => MutableByteArray (PrimState m)+  -> Int+  -> Word+  -> Word+  -> m ()+#ifndef BITVEC_THREADSAFE+modifyByteArray arr ix msk new = do+  old <- readByteArray arr ix+  writeByteArray arr ix (old .&. msk .|. new)+{-# INLINE modifyByteArray #-}+#else+modifyByteArray (MutableByteArray mba) (I# ix) (W# msk) (W# new) = do+  primitive $ \state ->+    let !(# state',  _ #) = fetchAndIntArray# mba ix (word2Int# msk) state  in+    let !(# state'', _ #) = fetchOrIntArray#  mba ix (word2Int# new) state' in+    (# state'', () #)++-- https://gitlab.haskell.org/ghc/ghc/issues/17334+#if __GLASGOW_HASKELL__ == 808 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1+{-# NOINLINE modifyByteArray #-}+#else+{-# INLINE modifyByteArray #-}+#endif++#endif+ -- | 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 = do-  let len    = off + len'-      lenMod = modWordSize len-      i      = off + i'-      nMod   = modWordSize i-      loIx   = divWordSize i+writeWord !(BitMVec off len' arr) !i' !x+  | iMod == 0+  = if len >= i + wordSize+    then writeByteArray arr iDiv x+    else modifyByteArray arr iDiv (hiMask lenMod) (x .&. loMask lenMod)+  | iDiv == divWordSize (len - 1)+  = if lenMod == 0+    then modifyByteArray arr iDiv (loMask iMod) (x `unsafeShiftL` iMod)+    else modifyByteArray arr iDiv (loMask iMod .|. hiMask lenMod) ((x `unsafeShiftL` iMod) .&. loMask lenMod)+  | iDiv + 1 == divWordSize (len - 1)+  = do+    modifyByteArray arr iDiv (loMask iMod) (x `unsafeShiftL` iMod)+    if lenMod == 0+    then modifyByteArray arr (iDiv + 1) (hiMask iMod) (x `unsafeShiftR` (wordSize - iMod))+    else modifyByteArray arr (iDiv + 1) (hiMask iMod .|. hiMask lenMod) (x `unsafeShiftR` (wordSize - iMod) .&. loMask lenMod)+  | otherwise+  = do+    modifyByteArray arr iDiv (loMask iMod) (x `unsafeShiftL` iMod)+    modifyByteArray arr (iDiv + 1) (hiMask iMod) (x `unsafeShiftR` (wordSize - iMod))+  where+    len    = off + len'+    lenMod = modWordSize len+    i      = off + i'+    iMod   = modWordSize i+    iDiv   = divWordSize i -  if nMod == 0-    then if len >= i + wordSize-      then writeByteArray arr loIx x-      else do-        loWord <- readByteArray arr loIx-        writeByteArray arr loIx-          $   (loWord .&. hiMask lenMod)-          .|. (x .&. loMask lenMod)-    else if loIx == divWordSize (len - 1)-      then do-        loWord <- readByteArray arr loIx-        if lenMod == 0-          then-            writeByteArray arr loIx-            $   (loWord .&. loMask nMod)-            .|. (x `unsafeShiftL` nMod)-          else-            writeByteArray arr loIx-            $   (loWord .&. (loMask nMod .|. hiMask lenMod))-            .|. ((x `unsafeShiftL` nMod) .&. loMask lenMod)-      else do-        loWord <- readByteArray arr loIx-        writeByteArray arr loIx-          $   (loWord .&. loMask nMod)-          .|. (x `unsafeShiftL` nMod)-        hiWord <- readByteArray arr (loIx + 1)-        writeByteArray arr (loIx + 1)-          $   (hiWord .&. hiMask nMod)-          .|. (x `unsafeShiftR` (wordSize - nMod)) #if __GLASGOW_HASKELL__ >= 800 {-# SPECIALIZE writeWord :: U.MVector s Bit -> Int -> Word -> ST s () #-} #endif@@ -300,9 +319,7 @@       0    -> setByteArray arr offWords lWords (x :: Word)       nMod -> do         setByteArray arr offWords (lWords - 1) (x :: Word)-        lastWord <- readByteArray arr (offWords + lWords - 1)-        let lastWord' = lastWord .&. hiMask nMod .|. x .&. loMask nMod-        writeByteArray arr (offWords + lWords - 1) lastWord'+        modifyByteArray arr (offWords + lWords - 1) (hiMask nMod) (x .&. loMask nMod)    where     offBits  = modWordSize off     offWords = divWordSize off@@ -310,27 +327,16 @@   basicSet (BitMVec off len arr) (extendToWord -> x) =     case modWordSize (off + len) of       0 -> do-        firstWord <- readByteArray arr offWords-        let firstWord' = firstWord .&. loMask offBits .|. x .&. hiMask offBits-        writeByteArray arr offWords firstWord'+        modifyByteArray arr offWords (loMask offBits) (x .&. hiMask offBits)         setByteArray arr (offWords + 1) (lWords - 1) (x :: Word)       nMod -> if lWords == 1         then do-          theOnlyWord <- readByteArray arr offWords           let lohiMask = loMask offBits .|. hiMask nMod-              theOnlyWord' =-                theOnlyWord .&. lohiMask .|. x .&. complement lohiMask-          writeByteArray arr offWords theOnlyWord'+          modifyByteArray arr offWords lohiMask (x .&. complement lohiMask)         else do-          firstWord <- readByteArray arr offWords-          let firstWord' = firstWord .&. loMask offBits .|. x .&. hiMask offBits-          writeByteArray arr offWords firstWord'-+          modifyByteArray arr offWords (loMask offBits) (x .&. hiMask offBits)           setByteArray arr (offWords + 1) (lWords - 2) (x :: Word)--          lastWord <- readByteArray arr (offWords + lWords - 1)-          let lastWord' = lastWord .&. hiMask nMod .|. x .&. loMask nMod-          writeByteArray arr (offWords + lWords - 1) lastWord'+          modifyByteArray arr (offWords + lWords - 1) (hiMask nMod) (x .&. loMask nMod)    where     offBits  = modWordSize off     offWords = divWordSize off@@ -353,10 +359,7 @@                              (wordsToBytes $ lDstWords - 1)          lastWordSrc <- readByteArray src (offSrcWords + lDstWords - 1)-        lastWordDst <- readByteArray dst (offDstWords + lDstWords - 1)-        let lastWordDst' =-              lastWordDst .&. hiMask nMod .|. lastWordSrc .&. loMask nMod-        writeByteArray dst (offDstWords + lDstWords - 1) lastWordDst'+        modifyByteArray dst (offDstWords + lDstWords - 1) (hiMask nMod) (lastWordSrc .&. loMask nMod)    where     offDstBits  = modWordSize offDst     offDstWords = divWordSize offDst@@ -367,14 +370,7 @@     | offDstBits == offSrcBits = case modWordSize (offSrc + lenDst) of       0 -> do         firstWordSrc <- readByteArray src offSrcWords-        firstWordDst <- readByteArray dst offDstWords-        let firstWordDst' =-              firstWordDst-                .&. loMask offSrcBits-                .|. firstWordSrc-                .&. hiMask offSrcBits-        writeByteArray dst offDstWords firstWordDst'-+        modifyByteArray dst offDstWords (loMask offSrcBits) (firstWordSrc .&. hiMask offSrcBits)         copyMutableByteArray dst                              (wordsToBytes $ offDstWords + 1)                              src@@ -384,34 +380,17 @@         then do           let lohiMask = loMask offSrcBits .|. hiMask nMod           theOnlyWordSrc <- readByteArray src offSrcWords-          theOnlyWordDst <- readByteArray dst offDstWords-          let theOnlyWordDst' =-                theOnlyWordDst-                  .&. lohiMask-                  .|. theOnlyWordSrc-                  .&. complement lohiMask-          writeByteArray dst offDstWords theOnlyWordDst'+          modifyByteArray dst offDstWords lohiMask (theOnlyWordSrc .&. complement lohiMask)         else do           firstWordSrc <- readByteArray src offSrcWords-          firstWordDst <- readByteArray dst offDstWords-          let firstWordDst' =-                firstWordDst-                  .&. loMask offSrcBits-                  .|. firstWordSrc-                  .&. hiMask offSrcBits-          writeByteArray dst offDstWords firstWordDst'-+          modifyByteArray dst offDstWords (loMask offSrcBits) (firstWordSrc .&. hiMask offSrcBits)           copyMutableByteArray dst                                (wordsToBytes $ offDstWords + 1)                                src                                (wordsToBytes $ offSrcWords + 1)                                (wordsToBytes $ lDstWords - 2)-           lastWordSrc <- readByteArray src (offSrcWords + lDstWords - 1)-          lastWordDst <- readByteArray dst (offDstWords + lDstWords - 1)-          let lastWordDst' =-                lastWordDst .&. hiMask nMod .|. lastWordSrc .&. loMask nMod-          writeByteArray dst (offDstWords + lDstWords - 1) lastWordDst'+          modifyByteArray dst (offDstWords + lDstWords - 1) (hiMask nMod) (lastWordSrc .&. loMask nMod)    where     offDstBits  = modWordSize offDst     offDstWords = divWordSize offDst
src/Data/Bit/Mutable.hs view
@@ -104,8 +104,7 @@         writeWord vecYs 0 (f x y)       | otherwise = do         y <- readByteArray ys base-        writeByteArray ys base $-          (y .&. loMask shft) .|. (f (x `unsafeShiftL` shft) y .&. hiMask shft)+        modifyByteArray ys base (loMask shft) (f (x `unsafeShiftL` shft) y .&. hiMask shft)         go' (len - wordSize + shft) (offXs + wordSize - shft) (base + 1)       where         vecXs = BitVec  offXs len xs
src/Data/Bit/Utils.hs view
@@ -39,7 +39,7 @@ lgWordSize = case wordSize of   32 -> 5   64 -> 6-  _  -> error "wordsToBytes: unknown architecture"+  _  -> error "lgWordSize: unknown architecture"  wordSizeMask = wordSize - 1 wordSizeMaskC = complement wordSizeMask
test/Main.hs view
@@ -14,9 +14,11 @@ import Test.Tasty.QuickCheck  import Support+import Tests.Conc (concTests) import Tests.MVector (mvectorTests) import qualified Tests.MVectorTS as TS (mvectorTests) import Tests.SetOps (setOpTests)+import qualified Tests.SetOpsTS as TS (setOpTests) import Tests.Vector (vectorTests)  main :: IO ()@@ -26,7 +28,9 @@   , mvectorTests   , TS.mvectorTests   , setOpTests+  , TS.setOpTests   , vectorTests+  , concTests   ]  lawsTests :: TestTree@@ -53,6 +57,7 @@   , tenTimesLess $ testProperty "Multiplication long" prop_f2polyMulLong   , tenTimesLess $ testProperty "Square long" prop_f2polySqrLong   , testProperty "Remainder"      prop_f2polyRem+  , testProperty "GCD"            prop_f2polyGCD   , tenTimesLess $ lawsToTest $     showLaws (Proxy :: Proxy F2Poly) #if MIN_VERSION_quickcheck_classes(0,6,3)@@ -85,6 +90,17 @@  prop_f2polyRem :: F2Poly -> F2Poly -> Property prop_f2polyRem x y = y /= 0 ==> x `rem` y === fromInteger (toInteger x `binRem` toInteger y)++-- For polynomials @x@ and @y@, @gcdExt@ computes their unique greatest common+-- divisor @g@ and the unique coefficient polynomial @s@ satisfying @xs + yt = g@.+--+-- Thus it is sufficient to check @gcd == fst . gcdExt@ and @xs == g (mod y)@,+-- except if @y@ divides @x@, then @gcdExt x y@ is @(y, 0)@ and @xs `rem` y@ is zero,+-- so that it is then necessary to check @xs `rem` y == g `rem` y == 0@.+prop_f2polyGCD :: F2Poly -> F2Poly -> Property+prop_f2polyGCD x y = g === x `gcd` y .&&. (y /= 0 ==> (x * s) `rem` y === g `rem` y)+  where+    (g, s) = x `gcdExt` y  binMul :: Integer -> Integer -> Integer binMul = go 0
+ test/Tests/Conc.hs view
@@ -0,0 +1,64 @@+module Tests.Conc where++import Control.Concurrent+import Control.Monad+import Data.Bit.ThreadSafe+import Data.Bits+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed as U+import Test.Tasty+import Test.Tasty.HUnit++concTests :: TestTree+concTests = testGroup "Concurrency"+  [ testCase "invertInPlace"  case_conc_invert+  , testCase "reverseInPlace" case_conc_reverse+  , testCase "zipInPlace"     case_conc_zip+  ]++runConcurrently :: IO () -> IO () -> IO ()+runConcurrently action1 action2 = do+  m <- newEmptyMVar+  _ <- forkIO $ do+    action1+    putMVar m ()+  action2+  takeMVar m++case_conc_invert :: IO ()+case_conc_invert = replicateM_ 1000 $ do+  let len  = 64+      len' = 37+  vec <- M.replicate len (Bit True)+  ref <- V.freeze vec :: IO (U.Vector Bit)+  runConcurrently+    (replicateM_ 1000 $ invertInPlace (M.take len' vec))+    (replicateM_ 1000 $ invertInPlace (M.drop len' vec))+  wec <- V.unsafeFreeze vec+  assertEqual "should be equal" ref wec++case_conc_reverse :: IO ()+case_conc_reverse = replicateM_ 1000 $ do+  let len  = 128+      len' = 66+  vec <- M.new len+  forM_ [0 .. len - 1] $ \i -> M.write vec i (Bit $ odd i)+  ref <- V.freeze vec :: IO (U.Vector Bit)+  runConcurrently+    (replicateM_ 1000 $ reverseInPlace (M.take len' vec))+    (replicateM_ 1000 $ reverseInPlace (M.drop len' vec))+  wec <- V.unsafeFreeze vec+  assertEqual "should be equal" ref wec++case_conc_zip :: IO ()+case_conc_zip = replicateM_ 1000 $ do+  let len  = 128+      len' = 37+  vec <- M.replicate len (Bit True)+  let ref = V.replicate len (Bit False)+  runConcurrently+    (replicateM_ 1001 $ zipInPlace (const complement) ref (M.take len' vec))+    (replicateM_ 1001 $ zipInPlace (const complement) ref (M.drop len' vec))+  wec <- V.unsafeFreeze vec+  assertEqual "should be equal" ref wec
test/Tests/SetOps.hs view
@@ -1,29 +1,40 @@+{-# LANGUAGE CPP        #-} {-# LANGUAGE RankNTypes #-} +#ifndef BITVEC_THREADSAFE module Tests.SetOps where+#else+module Tests.SetOpsTS where+#endif  import Support () +import Control.Monad+import Control.Monad.ST import Data.Bit import Data.Bits import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU import Test.Tasty import Test.Tasty.QuickCheck hiding ((.&.))  setOpTests :: TestTree setOpTests = testGroup   "Set operations"-  [ testProperty "generalize"      prop_generalize-  , testProperty "zipBits"         prop_zipBits-  , testProperty "zipInPlace"      prop_zipInPlace-  , testProperty "invertBits"      prop_invertBits-  , testProperty "invertBitsWords" prop_invertBitsWords-  , testProperty "invertInPlace"   prop_invertInPlace-  , testProperty "reverseBits"     prop_reverseBits-  , testProperty "reverseInPlace"  prop_reverseInPlace-  , testProperty "selectBits"      prop_selectBits_def-  , testProperty "excludeBits"     prop_excludeBits_def-  , testProperty "countBits"       prop_countBits_def+  [ testProperty "generalize"       prop_generalize+  , testProperty "zipBits"          prop_zipBits+  , testProperty "zipInPlace"       prop_zipInPlace+  , testProperty "invertBits"       prop_invertBits+  , testProperty "invertBitsWords"  prop_invertBitsWords+  , testProperty "invertInPlace"    prop_invertInPlace+  , testProperty "invertInPlace middle" prop_invertInPlace_middle+  , testProperty "reverseBits"      prop_reverseBits+  , testProperty "reverseBitsWords" prop_reverseBitsWords+  , testProperty "reverseInPlace"   prop_reverseInPlace+  , testProperty "reverseInPlace middle" prop_reverseInPlace_middle+  , testProperty "selectBits"       prop_selectBits_def+  , testProperty "excludeBits"      prop_excludeBits_def+  , testProperty "countBits"        prop_countBits_def   ]  prop_generalize :: Fun (Bit, Bit) Bit -> Bit -> Bit -> Property@@ -73,13 +84,55 @@ prop_invertInPlace xs =   U.map complement xs === U.modify invertInPlace xs +prop_invertInPlace_middle :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property+prop_invertInPlace_middle (NonNegative from) (NonNegative len) (NonNegative excess) = runST $ do+  let totalLen = from + len + excess+  vec <- MU.new totalLen+  forM_ [0 .. totalLen - 1] $ \i ->+    MU.write vec i (Bit (odd i))+  ref <- U.freeze vec++  let middle = MU.slice from len vec+  invertInPlace middle+  wec <- U.unsafeFreeze vec++  let refLeft  = U.take from ref+      wecLeft  = U.take from wec+      refRight = U.drop (from + len) ref+      wecRight = U.drop (from + len) wec+  pure $ refLeft === wecLeft .&&. refRight === wecRight+ prop_reverseBits :: U.Vector Bit -> Property prop_reverseBits xs =   U.reverse xs === reverseBits xs +prop_reverseBitsWords :: U.Vector Word -> Property+prop_reverseBitsWords ws =+  U.reverse xs === reverseBits xs+  where+    xs = castFromWords ws+ prop_reverseInPlace :: U.Vector Bit -> Property prop_reverseInPlace xs =   U.reverse xs === U.modify reverseInPlace xs++prop_reverseInPlace_middle :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property+prop_reverseInPlace_middle (NonNegative from) (NonNegative len) (NonNegative excess) = runST $ do+  let totalLen = from + len + excess+  vec <- MU.new totalLen+  forM_ [0 .. totalLen - 1] $ \i ->+    MU.write vec i (Bit (odd i))+  ref <- U.freeze vec++  let middle = MU.slice from len vec+  reverseInPlace middle+  wec <- U.unsafeFreeze vec++  let refLeft  = U.take from ref+      wecLeft  = U.take from wec+      refRight = U.drop (from + len) ref+      wecRight = U.drop (from + len) wec+  pure $ refLeft === wecLeft .&&. refRight === wecRight  select :: U.Unbox a => U.Vector Bit -> U.Vector a -> U.Vector a select mask ws = U.map snd (U.filter (unBit . fst) (U.zip mask ws))
+ test/Tests/SetOpsTS.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE CPP #-}++#define BITVEC_THREADSAFE+#include "Tests/SetOps.hs"