bitvec 1.1.5.0 → 1.1.6.0
raw patch · 21 files changed
+135/−220 lines, 21 filesdep −integer-gmpdep ~basedep ~containersdep ~ghc-bignumPVP ok
version bump matches the API change (PVP)
Dependencies removed: integer-gmp
Dependency ranges changed: base, containers, ghc-bignum, primitive, tasty-bench, vector
API changes (from Hackage documentation)
Files
- bench/Bench.hs +1/−1
- bench/Bench/Intersection.hs +1/−2
- bench/Bench/Product.hs +1/−2
- bench/Bench/RandomFlip.hs +1/−0
- bench/Bench/RandomWrite.hs +1/−0
- bench/Bench/Remainder.hs +1/−11
- bench/Bench/Sum.hs +2/−2
- bench/Bench/Union.hs +1/−2
- bitvec.cabal +18/−29
- changelog.md +4/−0
- src/Data/Bit/F2Poly.hs +8/−62
- src/Data/Bit/Immutable.hs +3/−4
- src/Data/Bit/Internal.hs +9/−44
- src/Data/Bit/Mutable.hs +10/−8
- src/Data/Bit/Utils.hs +1/−36
- test/Main.hs +0/−1
- test/Tests/Conc.hs +3/−3
- test/Tests/F2Poly.hs +0/−8
- test/Tests/MVector.hs +44/−4
- test/Tests/SetOps.hs +25/−0
- test/Tests/Vector.hs +1/−1
bench/Bench.hs view
@@ -1,4 +1,4 @@-module Main where+module Main (main) where import Test.Tasty.Bench import Test.Tasty.Patterns.Printer
bench/Bench/Intersection.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Avoid lambda" #-}+{- HLINT ignore "Avoid lambda" -} module Bench.Intersection ( benchIntersection
bench/Bench/Product.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Avoid lambda" #-}+{- HLINT ignore "Avoid lambda" -} module Bench.Product ( benchProduct
bench/Bench/RandomFlip.hs view
@@ -2,6 +2,7 @@ ( benchRandomFlip ) where +import Prelude hiding (Foldable(..)) import Control.Monad import Control.Monad.ST import Data.Bit
bench/Bench/RandomWrite.hs view
@@ -2,6 +2,7 @@ ( benchRandomWrite ) where +import Prelude hiding (Foldable(..)) import Control.Monad import Control.Monad.ST import Data.Bit
bench/Bench/Remainder.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Avoid lambda" #-}+{- HLINT ignore "Avoid lambda" -} module Bench.Remainder ( benchRemainder@@ -11,11 +9,7 @@ import qualified Data.Bit.ThreadSafe as TS import Data.Bits import GHC.Exts-#ifdef MIN_VERSION_ghc_bignum import GHC.Num.Integer-#else-import GHC.Integer.Logarithms-#endif import Test.Tasty.Bench import Bench.Common@@ -30,11 +24,7 @@ binRem :: Integer -> Integer -> Integer binRem x y = go x where-#ifdef MIN_VERSION_ghc_bignum binLog n = I# (word2Int# (integerLog2# n))-#else- binLog n = I# (integerLog2# n)-#endif ly = binLog y go z = if lz < ly then z else go (z `xor` (y `shiftL` (lz - ly)))
bench/Bench/Sum.hs view
@@ -1,11 +1,11 @@-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Avoid lambda" #-}+{- HLINT ignore "Avoid lambda" -} module Bench.Sum ( benchAdd , benchSum ) where +import Prelude hiding (Foldable(..)) import Data.Bit import qualified Data.Bit.ThreadSafe as TS import Data.Bits
bench/Bench/Union.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}-{-# HLINT ignore "Avoid lambda" #-}+{- HLINT ignore "Avoid lambda" -} module Bench.Union ( benchUnion
bitvec.cabal view
@@ -1,5 +1,5 @@ name: bitvec-version: 1.1.5.0+version: 1.1.6.0 cabal-version: 2.0 build-type: Simple license: BSD3@@ -51,14 +51,14 @@ author: Andrew Lelechenko <andrew.lelechenko@gmail.com>, James Cook <mokus@deepbondi.net> -tested-with: GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1 GHC ==8.8.2 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.2 GHC ==9.2.7 GHC ==9.4.4 GHC ==9.6.1+tested-with: GHC ==9.0.2 GHC ==9.2.8 GHC ==9.4.8 GHC ==9.6.7 GHC ==9.8.4 GHC ==9.10.3 GHC ==9.12.2 GHC ==9.14.1 extra-doc-files: changelog.md README.md source-repository head type: git- location: git://github.com/Bodigrim/bitvec.git+ location: https://github.com/Bodigrim/bitvec.git flag simd description:@@ -72,11 +72,12 @@ Data.Bit Data.Bit.ThreadSafe build-depends:- base >=4.11 && <5,+ base >=4.15 && <5, bytestring >=0.10 && <0.13, deepseq <1.6,- primitive >=0.5,- vector >=0.11 && <0.14+ ghc-bignum <1.5,+ primitive >=0.5 && <0.10,+ vector >=0.13 && <0.14 default-language: Haskell2010 hs-source-dirs: src other-modules:@@ -92,12 +93,6 @@ Data.Bit.Utils ghc-options: -O2 -Wall -Wcompat include-dirs: src-- if impl(ghc <9.0)- build-depends: integer-gmp- else- build-depends: ghc-bignum- if flag(simd) && !arch(javascript) && !arch(wasm32) c-sources: cbits/bitvec_simd.c cc-options: -fopenmp-simd@@ -111,12 +106,13 @@ build-depends: base, bitvec,- primitive >=0.5 && <0.9,+ ghc-bignum,+ primitive >=0.5 && <0.10, quickcheck-classes-base <0.7, quickcheck-classes >=0.6.1 && <0.7, vector >=0.11,- tasty <1.5,- tasty-quickcheck <0.11+ tasty <1.6,+ tasty-quickcheck <0.12 default-language: Haskell2010 hs-source-dirs: test other-modules:@@ -128,22 +124,20 @@ Tests.SetOps Tests.SetOpsTS Tests.Vector- ghc-options: -Wall -threaded -rtsopts -Wcompat+ ghc-options: -Wall -Wcompat+ if !arch(wasm32)+ ghc-options: -threaded -rtsopts include-dirs: test - if impl(ghc <9.0)- build-depends: integer-gmp <1.2- else- build-depends: ghc-bignum- benchmark bitvec-bench build-depends: base, bitvec,- containers <0.7,- random <1.3,+ containers <0.9,+ ghc-bignum,+ random <1.4, tasty,- tasty-bench >=0.3.2 && <0.4,+ tasty-bench >=0.4 && <0.6, vector type: exitcode-stdio-1.0 main-is: Bench.hs@@ -164,8 +158,3 @@ Bench.Sum Bench.Union ghc-options: -O2 -Wall -Wcompat-- if impl(ghc <9.0)- build-depends: integer-gmp- else- build-depends: ghc-bignum
changelog.md view
@@ -1,3 +1,7 @@+# 1.1.6.0++* Make `basicOverlaps` precise instead of rounding bounds up to the next `Word`.+ # 1.1.5.0 * Make `zipBits` unconditionally strict in its second bit
src/Data/Bit/F2Poly.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-}@@ -36,24 +35,17 @@ import Data.Char import Data.Coerce import Data.Primitive.ByteArray-import Data.Typeable import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts import GHC.Generics-import Numeric--#ifdef MIN_VERSION_ghc_bignum import GHC.Num.BigNat import GHC.Num.Integer-#else-import GHC.Integer.GMP.Internals-import GHC.Integer.Logarithms-#endif+import Numeric -- | Binary polynomials of one variable, backed--- by an unboxed 'Data.Vector.Unboxed.Vector' 'Bit'.+-- by an unboxed 'Data.Vector.Unboxed.Vector' t'Bit'. -- -- Polynomials are stored normalized, without leading zero coefficients. --@@ -68,7 +60,7 @@ -- @since 1.0.1.0 newtype F2Poly = F2Poly { unF2Poly :: U.Vector Bit- -- ^ Convert an 'F2Poly' to a vector of coefficients+ -- ^ Convert an t'F2Poly' to a vector of coefficients -- (first element corresponds to a constant term). -- -- >>> :set -XBinaryLiterals@@ -77,9 +69,9 @@ -- -- @since 1.0.1.0 }- deriving (Eq, Ord, Typeable, Generic, NFData)+ deriving (Eq, Ord, Generic, NFData) --- | Make an 'F2Poly' from a list of coefficients+-- | Make an t'F2Poly' from a list of coefficients -- (first element corresponds to a constant term). -- -- >>> :set -XOverloadedLists@@ -92,21 +84,13 @@ zero :: F2Poly zero = F2Poly $ BitVec 0 0 $-#ifdef MIN_VERSION_ghc_bignum ByteArray (unBigNat bigNatZero)-#else- fromBigNat zeroBigNat-#endif one :: F2Poly one = F2Poly $ BitVec 0 1 $-#ifdef MIN_VERSION_ghc_bignum ByteArray (unBigNat bigNatOne)-#else- fromBigNat oneBigNat-#endif --- -- | A valid 'F2Poly' has offset 0 and no trailing garbage.+-- -- | A valid t'F2Poly' has offset 0 and no trailing garbage. -- _isValid :: F2Poly -> Bool -- _isValid (F2Poly (BitVec o l arr)) = o == 0 && l == l' -- where@@ -117,7 +101,7 @@ -- 'abs' = 'id' and 'signum' = 'const' 1. -- -- 'fromInteger' converts a binary polynomial, encoded as 'Integer',--- to 'F2Poly' encoding.+-- to t'F2Poly' encoding. instance Num F2Poly where (+) = coerce xorBits (-) = coerce xorBits@@ -125,7 +109,6 @@ abs = id signum = const one (*) = coerce ((dropWhileEnd .) . karatsuba)-#ifdef MIN_VERSION_ghc_bignum fromInteger !n = case n of IS i# | n < 0 -> throw Underflow@@ -134,16 +117,6 @@ IP bn# -> F2Poly $ BitVec 0 (I# (word2Int# (integerLog2# n)) + 1) $ ByteArray bn# IN{} -> throw Underflow {-# INLINE fromInteger #-}-#else- fromInteger !n = case n of- S# i#- | n < 0 -> throw Underflow- | otherwise -> F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#))))- $ fromBigNat $ wordToBigNat (int2Word# i#)- Jp# bn# -> F2Poly $ BitVec 0 (I# (integerLog2# n) + 1) $ fromBigNat bn#- Jn#{} -> throw Underflow- {-# INLINE fromInteger #-}-#endif {-# INLINE (+) #-} {-# INLINE (-) #-}@@ -154,25 +127,16 @@ instance Enum F2Poly where fromEnum = fromIntegral-#ifdef MIN_VERSION_ghc_bignum 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#))))- $ fromBigNat $ wordToBigNat (int2Word# i#)-#endif instance Real F2Poly where toRational = fromIntegral --- | 'toInteger' converts a binary polynomial, encoded as 'F2Poly',+-- | 'toInteger' converts a binary polynomial, encoded as t'F2Poly', -- to an 'Integer' encoding. instance Integral F2Poly where-#ifdef MIN_VERSION_ghc_bignum toInteger xs = integerFromBigNat# (bitsToByteArray (unF2Poly xs))-#else- toInteger xs = bigNatToInteger (BN# (bitsToByteArray (unF2Poly xs)))-#endif quotRem (F2Poly xs) (F2Poly ys) = (F2Poly (dropWhileEnd qs), F2Poly (dropWhileEnd rs)) where (qs, rs) = quotRemBits xs ys@@ -191,21 +155,12 @@ xorBits xs (BitVec _ 0 _) = xs -- GMP has platform-dependent ASM implementations for mpn_xor_n, -- which are impossible to beat by native Haskell.-#ifdef MIN_VERSION_ghc_bignum xorBits (BitVec 0 lx (ByteArray xarr)) (BitVec 0 ly (ByteArray yarr)) = case lx `compare` ly of LT -> BitVec 0 ly zs EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs GT -> BitVec 0 lx zs where zs = ByteArray (xarr `bigNatXor` yarr)-#else-xorBits (BitVec 0 lx xarr) (BitVec 0 ly yarr) = case lx `compare` ly of- LT -> BitVec 0 ly zs- EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs- GT -> BitVec 0 lx zs- where- zs = fromBigNat (toBigNat xarr `xorBigNat` toBigNat yarr)-#endif xorBits xs ys = dropWhileEnd $ runST $ do let lx = U.length xs ly = U.length ys@@ -330,15 +285,6 @@ where ys = if U.null xs then U.singleton (0 :: Word) else cloneToWords xs !(P.Vector _ _ (ByteArray arr)) = toPrimVector ys--#ifdef MIN_VERSION_ghc_bignum-#else-fromBigNat :: BigNat -> ByteArray-fromBigNat (BN# arr) = ByteArray arr--toBigNat :: ByteArray -> BigNat-toBigNat (ByteArray arr) = BN# arr-#endif -- | Execute the extended Euclidean algorithm. -- For polynomials @a@ and @b@, compute their unique greatest common divisor @g@
src/Data/Bit/Immutable.hs view
@@ -1,15 +1,14 @@-{-# LANGUAGE CPP #-}- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Immutable
src/Data/Bit/Internal.hs view
@@ -1,15 +1,13 @@-{-# LANGUAGE CPP #-}- {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ViewPatterns #-}+{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Internal@@ -27,12 +25,6 @@ , modifyByteArray ) where -#if MIN_VERSION_vector(0,13,0)-import Data.Vector.Internal.Check (checkIndex, Checks(..))-#else-#include "vector.h"-#endif- import Control.DeepSeq import Control.Exception import Control.Monad.Primitive@@ -41,9 +33,9 @@ import Data.Bit.Utils import Data.Primitive.ByteArray import Data.Ratio-import Data.Typeable import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as MV+import Data.Vector.Internal.Check (checkIndex, Checks(..)) import qualified Data.Vector.Unboxed as U import GHC.Generics @@ -55,7 +47,7 @@ -- | A newtype wrapper with a custom instance -- for "Data.Vector.Unboxed", which packs booleans -- as efficient as possible (8 values per byte).--- Unboxed vectors of `Bit` use 8x less memory+-- Unboxed vectors of t'Bit' use 8x less memory -- than unboxed vectors of 'Bool' (which store one value per byte), -- but random writes are slightly slower. --@@ -65,7 +57,7 @@ } deriving (Bounded, Enum, Eq, Ord , FiniteBits -- ^ @since 0.2.0.0- , Bits, Typeable+ , Bits , Generic -- ^ @since 1.0.1.0 , NFData -- ^ @since 1.0.1.0 )@@ -73,7 +65,7 @@ -- | A newtype wrapper with a custom instance -- for "Data.Vector.Unboxed", which packs booleans -- as efficient as possible (8 values per byte).--- Unboxed vectors of `Bit` use 8x less memory+-- Unboxed vectors of t'Bit' use 8x less memory -- than unboxed vectors of 'Bool' (which store one value per byte), -- but random writes are slightly slower. --@@ -83,7 +75,7 @@ } deriving (Bounded, Enum, Eq, Ord , FiniteBits -- ^ @since 0.2.0.0- , Bits, Typeable+ , Bits , Generic -- ^ @since 1.0.1.0 , NFData -- ^ @since 1.0.1.0 )@@ -91,7 +83,7 @@ -- | There is only one lawful 'Num' instance possible -- with '+' = 'xor' and--- 'fromInteger' = 'Bit' . 'odd'.+-- 'fromInteger' = v'Bit' . 'odd'. -- -- @since 1.0.1.0 instance Num Bit where@@ -204,16 +196,9 @@ 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 ()@@ -266,14 +251,10 @@ pure $ BitMVec 0 n arr {-# INLINE basicOverlaps #-}- basicOverlaps (BitMVec i' m' arr1) (BitMVec j' n' arr2) =+ basicOverlaps (BitMVec i m arr1) (BitMVec j n arr2) = sameMutableByteArray arr1 arr2 && (between i j (j + n) || between j i (i + m)) where- i = divWordSize i'- m = nWords (i' + m') - i- j = divWordSize j'- n = nWords (j' + n') - j between x y z = x >= y && x < z {-# INLINE basicLength #-}@@ -446,11 +427,7 @@ -- @since 1.0.0.0 unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () unsafeFlipBit v i =-#if MIN_VERSION_vector(0,13,0) checkIndex Unsafe-#else- UNSAFE_CHECK(checkIndex) "flipBit"-#endif i (MV.length v) $ basicFlipBit v i {-# INLINE unsafeFlipBit #-} @@ -479,11 +456,7 @@ -- @since 1.0.0.0 flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () flipBit v i =-#if MIN_VERSION_vector(0,13,0) checkIndex Bounds-#else- BOUNDS_CHECK(checkIndex) "flipBit"-#endif i (MV.length v) $ unsafeFlipBit v i {-# INLINE flipBit #-}@@ -503,11 +476,7 @@ -- [1,0,1] unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () unsafeFlipBit v i =-#if MIN_VERSION_vector(0,13,0) checkIndex Unsafe-#else- UNSAFE_CHECK(checkIndex) "flipBit"-#endif i (MV.length v) $ basicFlipBit v i {-# INLINE unsafeFlipBit #-} @@ -532,11 +501,7 @@ -- [1,0,1] flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () flipBit v i =-#if MIN_VERSION_vector(0,13,0) checkIndex Bounds-#else- BOUNDS_CHECK(checkIndex) "flipBit"-#endif i (MV.length v) $ basicFlipBit v i {-# INLINE flipBit #-}
src/Data/Bit/Mutable.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE CPP #-}- {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Mutable@@ -116,15 +116,19 @@ -- rewriting the contents of the second argument. -- Cf. 'Data.Bit.zipBits'. ----- Note: If one input is larger than the other, the remaining bits will be ignored.--- -- >>> :set -XOverloadedLists -- >>> import Data.Bits -- >>> Data.Vector.Unboxed.modify (zipInPlace (.&.) [1,1,0]) [0,1,1] -- [0,1,0]+-- >>> Data.Vector.Unboxed.modify (zipInPlace (\x y -> x .&. complement y) [1,1,0]) [0,1,1]+-- [1,0,0] ----- __Warning__: if the immutable vector is shorter than the mutable one,--- it is the caller's responsibility to trim the result:+-- __Warning__:+-- If the immutable vector is longer than the mutable one,+-- trailing bits will be ignored.+-- If it's a mutable vector who is longer,+-- trailing bits will be kept unchanged;+-- it is caller's responsibility to trim the result: -- -- >>> :set -XOverloadedLists -- >>> import Data.Bits@@ -201,7 +205,6 @@ writeByteArray ys i (f x y) loop (i + 1) accNew -{-# SPECIALIZE zipInPlace :: (forall a. Bits a => a -> a -> a) -> Vector Bit -> MVector s Bit -> ST s () #-} {-# INLINABLE zipInPlace #-} -- | Apply a function to a mutable vector bitwise,@@ -224,7 +227,6 @@ (False, True) -> const $ pure () (True, False) -> invertInPlace (True, True) -> (`MU.set` Bit True)-{-# SPECIALIZE mapInPlace :: (forall a. Bits a => a -> a) -> MVector s Bit -> ST s () #-} {-# INLINE mapInPlace #-} -- | Invert (flip) all bits in-place.
src/Data/Bit/Utils.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MagicHash #-} module Data.Bit.Utils ( lgWordSize@@ -29,9 +27,7 @@ import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Base as UB-#if __GLASGOW_HASKELL__ >= 810 import GHC.Exts-#endif import Data.Bit.PdepPext @@ -102,39 +98,8 @@ 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#)--#else--reverseWord :: Word -> Word-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)--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)--#endif reversePartialWord :: Int -> Word -> Word reversePartialWord n w
test/Main.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-} module Main where
test/Tests/Conc.hs view
@@ -29,7 +29,7 @@ takeMVar m case_conc_invert :: Property-case_conc_invert = ioProperty $ replicateM_ 1000 $ do+case_conc_invert = once $ ioProperty $ replicateM_ 1000 $ do let len = 64 len' = 37 vec <- M.replicate len (Bit True)@@ -41,7 +41,7 @@ pure $ ref === wec case_conc_reverse :: Property-case_conc_reverse = ioProperty $ replicateM_ 1000 $ do+case_conc_reverse = once $ ioProperty $ replicateM_ 1000 $ do let len = 128 len' = 66 vec <- M.new len@@ -54,7 +54,7 @@ pure $ ref === wec case_conc_zip :: Property-case_conc_zip = ioProperty $ replicateM_ 1000 $ do+case_conc_zip = once $ ioProperty $ replicateM_ 1000 $ do let len = 128 len' = 37 vec <- M.replicate len (Bit True)
test/Tests/F2Poly.hs view
@@ -10,11 +10,7 @@ import Data.Bits import Data.Ratio import GHC.Exts-#ifdef MIN_VERSION_ghc_bignum import GHC.Num.Integer-#else-import GHC.Integer.Logarithms-#endif import Test.Tasty import Test.Tasty.QuickCheck @@ -98,11 +94,7 @@ binRem :: Integer -> Integer -> Integer binRem x y = go x where-#ifdef MIN_VERSION_ghc_bignum binLog n = I# (word2Int# (integerLog2# n))-#else- binLog n = I# (integerLog2# n)-#endif ly = binLog y go 0 = 0
test/Tests/MVector.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-} + #ifndef BITVEC_THREADSAFE module Tests.MVector (mvectorTests) where #else@@ -9,6 +11,7 @@ import Support import Control.Exception+import Control.Monad import Control.Monad.ST #ifndef BITVEC_THREADSAFE import Data.Bit@@ -69,6 +72,9 @@ testProperty "flipBit" prop_flipBit , testProperty "new negative" prop_new_neg , testProperty "replicate negative" prop_replicate_neg+ , testProperty "move preserves data around" prop_move_around+ , adjustOption (\(QuickCheckMaxRatio n) -> QuickCheckMaxRatio (max 1000 n)) $+ testProperty "copy preserves data around" prop_copy_around ] prop_flipBit :: U.Vector Bit -> NonNegative Int -> Property@@ -76,7 +82,7 @@ where k' = k `mod` U.length xs ys = U.modify (\v -> M.modify v complement k') xs- ys' = U.modify (\v -> flipBit v k') xs+ ys' = U.modify (`flipBit` k') xs case_write_init_read1 :: Property case_write_init_read1 = (=== Bit True) $ runST $ do@@ -233,7 +239,7 @@ prop_castFromWords_def :: N.New U.Vector Word -> Property prop_castFromWords_def ws =- runST (N.run ws >>= pure . castFromWordsM >>= V.unsafeFreeze)+ runST (N.run ws >>= V.unsafeFreeze . castFromWordsM) === castFromWords (V.new ws) prop_cloneToWords_def :: N.New U.Vector Bit -> Property@@ -266,12 +272,46 @@ prop_replicate_neg (Positive n) x = ioProperty $ do ret <- try (evaluate (runST $ MG.basicUnsafeReplicate (-n) x >>= U.unsafeFreeze)) pure $ property $ case ret of- Left ErrorCallWithLocation{} -> True+ Left (_ :: SomeException) -> True _ -> False prop_new_neg :: Positive Int -> Property prop_new_neg (Positive n) = ioProperty $ do ret <- try (evaluate (runST $ MG.basicUnsafeNew (-n) >>= U.unsafeFreeze :: U.Vector Bit)) pure $ property $ case ret of- Left ErrorCallWithLocation{} -> True+ Left (_ :: SomeException) -> True _ -> False++prop_move_around :: Int -> Int -> Int -> U.Vector Bit -> Property+prop_move_around srcFrom' sliceLen' dstFrom' xs = ioProperty $ do+ let l = U.length xs+ when (l < 1) discard+ let sliceLen = sliceLen' `mod` l+ srcFrom = srcFrom' `mod` (l - sliceLen)+ dstFrom = dstFrom' `mod` (l - sliceLen)+ ys <- V.thaw xs+ let src = M.slice srcFrom sliceLen ys+ dst = M.slice dstFrom sliceLen ys+ M.move dst src+ xs' <- V.unsafeFreeze ys+ let slicePrefix = V.slice 0 dstFrom+ sliceSuffix = V.slice (dstFrom + sliceLen) (l - dstFrom - sliceLen)+ pure $ slicePrefix xs === slicePrefix xs' .&&. sliceSuffix xs === sliceSuffix xs'++prop_copy_around :: Bool -> Int -> Int -> Int -> U.Vector Bit -> Property+prop_copy_around b srcFrom' sliceLen' dstFrom' xs = ioProperty $ do+ let l = U.length xs+ when (l < 4) discard+ let sliceLen = 1 + sliceLen' `mod` ((l - 2) `quot` 2)+ firstFrom = srcFrom' `mod` (l - 2 * sliceLen)+ secondFrom = firstFrom + sliceLen + dstFrom' `mod` (l - firstFrom - 2 * sliceLen)+ (srcFrom, dstFrom) = if b then (firstFrom, secondFrom) else (secondFrom, firstFrom)+ ys <- V.thaw xs+ let src = M.slice srcFrom sliceLen ys+ dst = M.slice dstFrom sliceLen ys+ when (M.overlaps src dst) discard+ M.copy dst src+ xs' <- V.unsafeFreeze ys+ let slicePrefix = V.slice 0 dstFrom+ sliceSuffix = V.slice (dstFrom + sliceLen) (l - dstFrom - sliceLen)+ pure $ slicePrefix xs === slicePrefix xs' .&&. sliceSuffix xs === sliceSuffix xs'
test/Tests/SetOps.hs view
@@ -25,6 +25,7 @@ , twoTimesMore $ testProperty "zipBits" prop_zipBits , testProperty "zipInPlace" prop_zipInPlace+ , testProperty "zipInPlace around" prop_zipInPlace_around , testProperty "mapBits" prop_mapBits , testProperty "mapInPlace" prop_mapInPlace@@ -37,6 +38,7 @@ , mkGroup "invertBits" prop_invertBits , testProperty "invertInPlace" prop_invertInPlace+ , testProperty "invertInPlace around" prop_invertInPlace_around , testProperty "invertInPlaceWords" prop_invertInPlaceWords , testProperty "invertInPlace middle" prop_invertInPlace_middle , testProperty "invertInPlaceLong middle" prop_invertInPlaceLong_middle@@ -122,6 +124,18 @@ where f = curry $ applyFun fun +prop_zipInPlace_around :: Fun (Bit, Bit) Bit -> U.Vector Bit -> U.Vector Bit -> Property+prop_zipInPlace_around fun ts xs = ioProperty $ do+ let l = U.length xs+ f = curry $ applyFun fun+ when (l < 2) discard+ ys <- U.thaw xs+ let zs = MU.slice 1 (l - 2) ys+ zipInPlace (generalize2 f) ts zs+ hd <- MU.read ys 0+ lst <- MU.read ys (MU.length ys - 1)+ pure $ hd === U.head xs .&&. lst === U.last xs+ prop_mapBits :: Fun Bit Bit -> U.Vector Bit -> Property prop_mapBits fun xs = U.map (applyFun fun) xs === mapBits (generalize1 (applyFun fun)) xs@@ -137,6 +151,17 @@ prop_invertInPlace :: U.Vector Bit -> Property prop_invertInPlace xs = U.map complement xs === U.modify invertInPlace xs++prop_invertInPlace_around :: U.Vector Bit -> Property+prop_invertInPlace_around xs = ioProperty $ do+ let l = U.length xs+ when (l < 2) discard+ ys <- U.thaw xs+ let zs = MU.slice 1 (l - 2) ys+ invertInPlace zs+ hd <- MU.read ys 0+ lst <- MU.read ys (MU.length ys - 1)+ pure $ hd === U.head xs .&&. lst === U.last xs prop_invertInPlaceWords :: Large (U.Vector Bit) -> Property prop_invertInPlaceWords = prop_invertInPlace . getLarge
test/Tests/Vector.hs view
@@ -280,7 +280,7 @@ prop_nthBit_6 (NonNegative n) xs = ioProperty $ do ret <- try (evaluate (nthBitIndex (Bit True) (-n) xs)) pure $ property $ case ret of- Left ErrorCallWithLocation{} -> True+ Left ErrorCall{} -> True _ -> False case_nthBit_1 :: Property