diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# bitvec [![GitHub Build Status](https://github.com/Bodigrim/bitvec/workflows/ci/badge.svg)](https://github.com/Bodigrim/bitvec/actions?query=workflow%3Aci) [![Travis Build Status](https://travis-ci.com/Bodigrim/bitvec.svg)](https://travis-ci.com/Bodigrim/bitvec) [![Hackage](http://img.shields.io/hackage/v/bitvec.svg)](https://hackage.haskell.org/package/bitvec) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/bitvec/badge)](https://matrix.hackage.haskell.org/package/bitvec) [![Stackage LTS](http://stackage.org/package/bitvec/badge/lts)](http://stackage.org/lts/package/bitvec) [![Stackage Nightly](http://stackage.org/package/bitvec/badge/nightly)](http://stackage.org/nightly/package/bitvec) [![Coverage Status](https://coveralls.io/repos/github/Bodigrim/bitvec/badge.svg)](https://coveralls.io/github/Bodigrim/bitvec) +# bitvec [![Hackage](http://img.shields.io/hackage/v/bitvec.svg)](https://hackage.haskell.org/package/bitvec) [![Stackage LTS](http://stackage.org/package/bitvec/badge/lts)](http://stackage.org/lts/package/bitvec) [![Stackage Nightly](http://stackage.org/package/bitvec/badge/nightly)](http://stackage.org/nightly/package/bitvec) A newtype over `Bool` with a better `Vector` instance: 8x less memory, up to 1000x faster. diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,5 +0,0 @@ -#!/usr/bin/env runhaskell - -> import Distribution.Simple -> main = defaultMain - diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -1,6 +1,6 @@ module Main where -import Gauge.Main +import Test.Tasty.Bench import Bench.BitIndex import Bench.GCD diff --git a/bench/Bench/BitIndex.hs b/bench/Bench/BitIndex.hs --- a/bench/Bench/BitIndex.hs +++ b/bench/Bench/BitIndex.hs @@ -7,7 +7,7 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main +import Test.Tasty.Bench randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a randomVec f k = U.generate n (\i -> f (i == n - 1)) diff --git a/bench/Bench/GCD.hs b/bench/Bench/GCD.hs --- a/bench/Bench/GCD.hs +++ b/bench/Bench/GCD.hs @@ -7,8 +7,8 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools = map (> (0 :: Int)) $ randoms $ mkStdGen 42 diff --git a/bench/Bench/Intersection.hs b/bench/Bench/Intersection.hs --- a/bench/Bench/Intersection.hs +++ b/bench/Bench/Intersection.hs @@ -8,8 +8,8 @@ import qualified Data.IntSet as IS import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/Invert.hs b/bench/Bench/Invert.hs --- a/bench/Bench/Invert.hs +++ b/bench/Bench/Invert.hs @@ -7,8 +7,8 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/Product.hs b/bench/Bench/Product.hs --- a/bench/Bench/Product.hs +++ b/bench/Bench/Product.hs @@ -7,8 +7,8 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/RandomFlip.hs b/bench/Bench/RandomFlip.hs --- a/bench/Bench/RandomFlip.hs +++ b/bench/Bench/RandomFlip.hs @@ -7,11 +7,11 @@ import Data.Bit import qualified Data.Bit.ThreadSafe as TS import Data.Bits +import Data.Foldable import qualified Data.IntSet as IS -import Data.List import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomFlips :: [Int] randomFlips diff --git a/bench/Bench/RandomRead.hs b/bench/Bench/RandomRead.hs --- a/bench/Bench/RandomRead.hs +++ b/bench/Bench/RandomRead.hs @@ -10,8 +10,8 @@ -- import Data.List import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomVec :: [Bool] randomVec diff --git a/bench/Bench/RandomWrite.hs b/bench/Bench/RandomWrite.hs --- a/bench/Bench/RandomWrite.hs +++ b/bench/Bench/RandomWrite.hs @@ -7,11 +7,11 @@ import Data.Bit import qualified Data.Bit.ThreadSafe as TS import Data.Bits +import Data.Foldable import qualified Data.IntSet as IS -import Data.List import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomWrites :: [(Int, Bool)] randomWrites diff --git a/bench/Bench/Remainder.hs b/bench/Bench/Remainder.hs --- a/bench/Bench/Remainder.hs +++ b/bench/Bench/Remainder.hs @@ -10,7 +10,6 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import GHC.Exts #ifdef MIN_VERSION_ghc_bignum import GHC.Num.Integer @@ -18,6 +17,7 @@ import GHC.Integer.Logarithms #endif import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/Reverse.hs b/bench/Bench/Reverse.hs --- a/bench/Bench/Reverse.hs +++ b/bench/Bench/Reverse.hs @@ -7,8 +7,8 @@ import Data.Bits import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/Sum.hs b/bench/Bench/Sum.hs --- a/bench/Bench/Sum.hs +++ b/bench/Bench/Sum.hs @@ -5,11 +5,11 @@ import Data.Bit import qualified Data.Bit.ThreadSafe as TS import Data.Bits -import Data.List +import Data.Foldable import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bench/Bench/Union.hs b/bench/Bench/Union.hs --- a/bench/Bench/Union.hs +++ b/bench/Bench/Union.hs @@ -8,8 +8,8 @@ import qualified Data.IntSet as IS import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU -import Gauge.Main import System.Random +import Test.Tasty.Bench randomBools :: [Bool] randomBools diff --git a/bitvec.cabal b/bitvec.cabal --- a/bitvec.cabal +++ b/bitvec.cabal @@ -1,10 +1,10 @@ name: bitvec -version: 1.1.1.0 -cabal-version: 2.0 +version: 1.1.2.0 +cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE -copyright: 2019-2020 Andrew Lelechenko, 2012-2016 James Cook +copyright: 2019-2021 Andrew Lelechenko, 2012-2016 James Cook maintainer: Andrew Lelechenko homepage: https://github.com/Bodigrim/bitvec synopsis: Space-efficient bit vectors @@ -46,7 +46,7 @@ author: Andrew Lelechenko , James Cook -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.7 GHC ==9.0.1 GHC ==9.2.1 extra-source-files: changelog.md README.md @@ -61,6 +61,7 @@ `zipBits`, `invertBits` and `countBits`. Users are strongly encouraged to enable this flag whenever possible. default: False + manual: True library exposed-modules: @@ -70,7 +71,6 @@ base >=4.9 && <5, bytestring >=0.10, deepseq, - ghc-prim, primitive >=0.5, vector >=0.11 default-language: Haskell2010 @@ -87,10 +87,7 @@ Data.Bit.MutableTS Data.Bit.PdepPext Data.Bit.Utils - if flag(libgmp) - other-modules: - Data.Bit.Gmp - ghc-options: -O2 -Wall + ghc-options: -O2 -Wall -Wcompat include-dirs: src if impl(ghc <9.0) @@ -109,6 +106,7 @@ base, bitvec, primitive >=0.5, + quickcheck-classes-base, quickcheck-classes >=0.6.1, vector >=0.11, tasty, @@ -125,7 +123,7 @@ Tests.SetOps Tests.SetOpsTS Tests.Vector - ghc-options: -Wall -threaded -rtsopts + ghc-options: -Wall -threaded -rtsopts -Wcompat include-dirs: test if impl(ghc <9.0) @@ -139,11 +137,8 @@ bitvec, containers, random, + tasty-bench, 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 @@ -161,7 +156,7 @@ Bench.Reverse Bench.Sum Bench.Union - ghc-options: -O2 -Wall + ghc-options: -O2 -Wall -Wcompat if impl(ghc <9.0) build-depends: integer-gmp diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +# 1.1.2.0 + +* Fix `setBit`, `clearBit`, `complementBit` to preserve vector's length. +* Fix various issues on big-endian architectures. +* Fix Cabal 3.7+ incompatibility. + # 1.1.1.0 * Export `BitVec` and `BitMVec` constructors. 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 @@ -2,8 +2,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -37,6 +39,8 @@ , listBits ) where +#include "MachDeps.h" + import Control.Monad import Control.Monad.ST import Data.Bits @@ -61,6 +65,10 @@ import Data.Word import Unsafe.Coerce +#ifdef WORDS_BIGENDIAN +import GHC.Exts +#endif + #if UseLibGmp gmpLimbShift :: Int gmpLimbShift = case wordSize of @@ -84,6 +92,27 @@ | n < 0 || n >= U.length v = False | otherwise = unBit (U.unsafeIndex v n) + setBit v n + | n < 0 || n >= U.length v = v + | otherwise = runST $ do + u <- U.thaw v + MU.unsafeWrite u n (Bit True) + U.unsafeFreeze u + + clearBit v n + | n < 0 || n >= U.length v = v + | otherwise = runST $ do + u <- U.thaw v + MU.unsafeWrite u n (Bit False) + U.unsafeFreeze u + + complementBit v n + | n < 0 || n >= U.length v = v + | otherwise = runST $ do + u <- U.thaw v + unsafeFlipBit u n + U.unsafeFreeze u + bit n | n < 0 = U.empty | otherwise = runST $ do @@ -163,13 +192,31 @@ -- | Cast a unboxed vector of 'Word8' -- to an unboxed vector of bits. -- +-- On big-endian architectures 'castFromWords8' +-- resorts to copying instead of aliasing underlying arrays. +-- -- >>> :set -XOverloadedLists -- >>> castFromWords8 [123] -- [1,1,0,1,1,1,1,0] castFromWords8 :: U.Vector Word8 -> U.Vector Bit castFromWords8 ws = BitVec (off `shiftL` 3) (len `shiftL` 3) arr where +#ifdef WORDS_BIGENDIAN + P.Vector off' len arr' = unsafeCoerce ws + off = 0 + arr = runST $ do + let lenWords = nWords $ len `shiftL` 3 + len' = wordsToBytes lenWords + marr <- newByteArray len' + copyByteArray marr 0 arr' off' len + fillByteArray marr len (len' - len) 0 + forM_ [0..lenWords - 1] $ \i -> do + W# w <- readByteArray marr i + writeByteArray marr i (W# (byteSwap# w)) + unsafeFreezeByteArray marr +#else P.Vector off len arr = unsafeCoerce ws +#endif -- | Try to cast an unboxed vector of bits -- to an unboxed vector of 'Word8'. @@ -178,10 +225,14 @@ -- -- > castToWords8 (castFromWords8 v) == Just v castToWords8 :: U.Vector Bit -> Maybe (U.Vector Word8) +#ifdef WORDS_BIGENDIAN +castToWords8 = const Nothing +#else castToWords8 (BitVec s n ws) - | s .&. 7 == 0, n .&. 7 == 0 = - Just $ unsafeCoerce $ P.Vector (s `shiftR` 3) (n `shiftR` 3) ws + | s .&. 7 == 0, n .&. 7 == 0 + = Just $ unsafeCoerce $ P.Vector (s `shiftR` 3) (n `shiftR` 3) ws | otherwise = Nothing +#endif -- | Clone an unboxed vector of bits -- to a new unboxed vector of 'Word8'. diff --git a/src/Data/Bit/Mutable.hs b/src/Data/Bit/Mutable.hs --- a/src/Data/Bit/Mutable.hs +++ b/src/Data/Bit/Mutable.hs @@ -2,6 +2,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -26,6 +27,8 @@ , reverseInPlace ) where +#include "MachDeps.h" + import Control.Monad import Control.Monad.Primitive import Control.Monad.ST @@ -42,6 +45,10 @@ import qualified Data.Vector.Unboxed.Mutable as MU import Data.Word +#ifdef WORDS_BIGENDIAN +import GHC.Exts +#endif + -- | Cast a vector of words to a vector of bits. -- Cf. 'Data.Bit.castFromWords'. castFromWordsM :: MVector s Word -> MVector s Bit @@ -83,11 +90,20 @@ -> 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 + -- Take care about big-endian architectures: allocate full words! + actualLenBytes = (lenBits + 7) `shiftR` 3 + roundedLenBytes = wordsToBytes (nWords lenBits) + ws@(BitMVec _ _ arr) <- MU.unsafeNew (roundedLenBytes `shiftL` 3) + MU.unsafeCopy (MU.slice 0 lenBits ws) v + MU.set (MU.slice lenBits (roundedLenBytes `shiftL` 3 - lenBits) ws) (Bit False) + +#ifdef WORDS_BIGENDIAN + forM_ [0..nWords lenBits - 1] $ \i -> do + W# w <- readByteArray arr i + writeByteArray arr i (W# (byteSwap# w)) +#endif + + pure $ MU.MV_Word8 $ P.MVector 0 actualLenBytes arr {-# INLINE cloneToWords8M #-} -- | Zip two vectors with the given function. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -5,12 +5,15 @@ import Control.Exception import Data.Bit -import Data.Proxy -import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.QuickCheck +#ifdef MIN_VERSION_quickcheck_classes_base +import Data.Proxy +import Test.QuickCheck.Classes.Base import Support +#endif + import Tests.Conc (concTests) import Tests.F2Poly (f2polyTests) import Tests.MVector (mvectorTests) @@ -34,6 +37,7 @@ lawsTests :: TestTree lawsTests = adjustOption (const $ QuickCheckTests 100) $ testGroup "Bit" +#ifdef MIN_VERSION_quickcheck_classes_base $ map lawsToTest [ bitsLaws (Proxy :: Proxy Bit) , eqLaws (Proxy :: Proxy Bit) @@ -41,11 +45,10 @@ , boundedEnumLaws (Proxy :: Proxy Bit) , showLaws (Proxy :: Proxy Bit) , showReadLaws (Proxy :: Proxy Bit) -#if MIN_VERSION_quickcheck_classes(0,6,3) , numLaws (Proxy :: Proxy Bit) -#endif , integralLaws (Proxy :: Proxy Bit) ] ++ +#endif [ testProperty "divideByZero" prop_bitDivideByZero , testProperty "toRational" prop_bitToRational ] diff --git a/test/Support.hs b/test/Support.hs --- a/test/Support.hs +++ b/test/Support.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} @@ -15,10 +16,16 @@ import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic.New as N import qualified Data.Vector.Unboxed as U -import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.QuickCheck +#ifdef MIN_VERSION_quickcheck_classes_base +import Test.QuickCheck.Classes.Base +#endif +#ifdef MIN_VERSION_quickcheck_classes +import qualified Test.QuickCheck.Classes as QCC +#endif + instance Arbitrary Bit where arbitrary = Bit <$> arbitrary shrink = fmap Bit . shrink . unBit @@ -156,6 +163,14 @@ twoTimesMore = adjustOption $ \(QuickCheckTests n) -> QuickCheckTests (n * 2) +#ifdef MIN_VERSION_quickcheck_classes_base lawsToTest :: Laws -> TestTree lawsToTest (Laws name props) = testGroup name $ map (uncurry testProperty) props +#endif + +#ifdef MIN_VERSION_quickcheck_classes +lawsToTest' :: QCC.Laws -> TestTree +lawsToTest' (QCC.Laws name props) = + testGroup name $ map (uncurry testProperty) props +#endif diff --git a/test/Tests/F2Poly.hs b/test/Tests/F2Poly.hs --- a/test/Tests/F2Poly.hs +++ b/test/Tests/F2Poly.hs @@ -8,7 +8,6 @@ import Control.Exception import Data.Bit import Data.Bits -import Data.Proxy import Data.Ratio import GHC.Exts #ifdef MIN_VERSION_ghc_bignum @@ -16,10 +15,14 @@ #else import GHC.Integer.Logarithms #endif -import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.QuickCheck +#ifdef MIN_VERSION_quickcheck_classes_base +import Data.Proxy +import Test.QuickCheck.Classes.Base +#endif + import Support f2polyTests :: TestTree @@ -36,14 +39,14 @@ , testProperty "GCD" prop_f2polyGCD , testProperty "Enum" $ \n -> let x = toEnum n in toEnum (fromEnum x) === (x :: F2Poly) +#ifdef MIN_VERSION_quickcheck_classes_base , tenTimesLess $ lawsToTest $ showLaws (Proxy :: Proxy F2Poly) -#if MIN_VERSION_quickcheck_classes(0,6,3) , lawsToTest $ numLaws (Proxy :: Proxy F2Poly) -#endif , lawsToTest $ integralLaws (Proxy :: Proxy F2Poly) +#endif , testProperty "fromNegative" prop_f2polyFromNegative , testProperty "divideByZero" prop_f2polyDivideByZero , testProperty "toRational" prop_f2polyToRational diff --git a/test/Tests/MVector.hs b/test/Tests/MVector.hs --- a/test/Tests/MVector.hs +++ b/test/Tests/MVector.hs @@ -16,17 +16,20 @@ import Data.Bit.ThreadSafe #endif import Data.Bits -import Data.Proxy import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as MG import qualified Data.Vector.Generic.New as N import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as M -import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +#ifdef MIN_VERSION_quickcheck_classes +import Data.Proxy +import Test.QuickCheck.Classes +#endif + mvectorTests :: TestTree mvectorTests = testGroup "Data.Vector.Unboxed.Mutable.Bit" [ testGroup "Data.Vector.Unboxed.Mutable functions" @@ -43,7 +46,9 @@ , tenTimesLess $ testProperty "castToWords_2" prop_castToWords_2 ] - , lawsToTest $ muvectorLaws (Proxy :: Proxy Bit) +#ifdef MIN_VERSION_quickcheck_classes + , lawsToTest' $ muvectorLaws (Proxy :: Proxy Bit) +#endif , testCase "basicInitialize 1" case_write_init_read1 , testCase "basicInitialize 2" case_write_init_read2 , testCase "basicInitialize 3" case_write_init_read3 diff --git a/test/Tests/Vector.hs b/test/Tests/Vector.hs --- a/test/Tests/Vector.hs +++ b/test/Tests/Vector.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Tests.Vector ( vectorTests ) where @@ -9,11 +11,15 @@ import Data.Bit import Data.Bits import Data.List (findIndex) +import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import Data.Word import Test.Tasty -import Test.Tasty.QuickCheck +import Test.Tasty.QuickCheck (Property, NonNegative(..), Positive(..), testProperty, Large(..), (===), property, once, (==>), ioProperty, (.&&.), counterexample) +import Unsafe.Coerce +#include "MachDeps.h" + vectorTests :: TestTree vectorTests = testGroup "Data.Vector.Unboxed.Bit" [ testGroup "Data.Vector.Unboxed functions" @@ -82,6 +88,9 @@ , testProperty "zeroBits" prop_zeroBits , testProperty "bitSize" prop_bitSize , testProperty "isSigned" prop_isSigned + , testProperty "setBit" prop_setBit + , testProperty "clearBit" prop_clearBit + , testProperty "complementBit" prop_complementBit ] ] @@ -133,19 +142,31 @@ Just ws -> castFromWords ws === xs prop_cloneFromWords8_def :: U.Vector Word8 -> Property -prop_cloneFromWords8_def ws = - U.toList (castFromWords8 ws) === concatMap wordToBitList (U.toList ws) +prop_cloneFromWords8_def ws + = counterexample ("offset = " ++ show off ++ " len = " ++ show len) + $ U.toList (castFromWords8 ws) === concatMap wordToBitList (U.toList ws) + where + P.Vector off len _ = unsafeCoerce ws prop_cloneToWords8_def :: U.Vector Bit -> Property -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_cloneToWords8_def xs@(BitVec off len _) + = counterexample ("offset = " ++ show off ++ " len = " ++ show len) + $ U.toList (cloneToWords8 xs) === loop (U.toList xs) + where + loop [] = [] + loop bs = case packBitsToWord bs of + (w, bs') -> w : loop bs' prop_castToWords8_1 :: U.Vector Word8 -> Property -prop_castToWords8_1 ws = - Just ws === castToWords8 (castFromWords8 ws) +#ifdef WORDS_BIGENDIAN +prop_castToWords8_1 ws = Nothing === castToWords8 (castFromWords8 ws) +#else +prop_castToWords8_1 ws + = counterexample ("offset = " ++ show off ++ " len = " ++ show len) + $ Just ws === castToWords8 (castFromWords8 ws) + where + P.Vector off len _ = unsafeCoerce ws +#endif prop_castToWords8_2 :: U.Vector Bit -> Property prop_castToWords8_2 xs = case castToWords8 xs of @@ -323,7 +344,18 @@ prop_isSigned :: U.Vector Bit -> Property prop_isSigned v = isSigned v === False +prop_setBit :: Int -> U.Vector Bit -> Property +prop_setBit n v = v `setBit` n === U.imap ((.|.) . Bit . (== n)) v + +prop_clearBit :: Int -> U.Vector Bit -> Property +prop_clearBit n v = v `clearBit` n === U.imap ((.&.) . Bit . (/= n)) v + +prop_complementBit :: Int -> U.Vector Bit -> Property +prop_complementBit n v = v `complementBit` n === U.imap (xor . Bit . (== n)) v + prop_cloneToByteString :: U.Vector Bit -> Property -prop_cloneToByteString v = cloneToByteString (cloneFromByteString bs) === bs +prop_cloneToByteString v@(BitVec off len _) + = counterexample ("offset = " ++ show off ++ " len = " ++ show len) + $ cloneToByteString (cloneFromByteString bs) === bs where bs = cloneToByteString v