diff --git a/bit-vector.cabal b/bit-vector.cabal --- a/bit-vector.cabal +++ b/bit-vector.cabal @@ -1,6 +1,7 @@ Name: bit-vector -Version: 0.1.0 +Version: 0.2.0 Synopsis: Simple bit vectors for Haskell +Description: Operations for using a vector of Booleans as a bit vector. Intended more for pedagogical purposes than for serious applications Homepage: https://github.com/acfoltzer/bit-vector Bug-reports: https://github.com/acfoltzer/bit-vector/issues License: BSD3 @@ -8,7 +9,6 @@ Author: Adam C. Foltzer Maintainer: acfoltzer@gmail.com Category: Data, Bit Vectors -Tested-With: GHC==7.0.4, GHC==7.2.1 Build-type: Simple Cabal-version: >=1.8 extra-source-files: README.md, test/Data/Vector/Bit/Tests.hs @@ -16,21 +16,22 @@ Library Exposed-modules: Data.Vector.Bit Hs-source-dirs: src - Build-depends: base == 4.*, - vector == 0.9.* + Build-depends: base >= 4.4 && < 5, + vector >= 0.9 ghc-options: -Wall -- orphans are kind of the point -fno-warn-orphans - + Test-Suite Tests - Type: exitcode-stdio-1.0 + Type: exitcode-stdio-1.0 hs-source-dirs: test - Main-is: Data/Vector/Bit/Tests.hs - Build-depends: base == 4.*, - vector == 0.9.*, - QuickCheck == 2.4.*, - test-framework >= 0.4.1.1, - test-framework-quickcheck2 == 0.2.*, + Main-is: Data/Vector/Bit/Tests.hs + Build-depends: base, + vector >= 0.9, + QuickCheck >= 2.4, + tasty >= 0.10, + tasty-th >= 0.1, + tasty-quickcheck >= 0.8, bit-vector source-repository head diff --git a/src/Data/Vector/Bit.hs b/src/Data/Vector/Bit.hs --- a/src/Data/Vector/Bit.hs +++ b/src/Data/Vector/Bit.hs @@ -2,16 +2,17 @@ Module : Data.Vector.Bit Description : Simple bit vectors for Haskell -Copyright : (c) Adam C. Foltzer 2011 +Copyright : (c) Adam C. Foltzer 2011-2015 License : BSD3 Maintainer : acfoltzer@gmail.com Stability : experimental -Portability : non-portable +Portability : portable -} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -20,7 +21,7 @@ BitVector, -- * Conversions - + -- ** To and from other 'Bits' instances unpack, pack, @@ -28,12 +29,13 @@ unpackInteger, packInteger, unpackInt, packInt, -- * Utilities - pad, padMax, zipPad, trimLeading + pad, padMax, zipPad, trimLeading, (==~) ) where import Data.Bits +import Data.Function import qualified Data.Vector.Unboxed as V -- | A 'BitVector' is a little-endian 'V.Vector' of @@ -57,11 +59,21 @@ zipPad :: BitVector -> BitVector -> V.Vector (Bool, Bool) zipPad xs ys = uncurry V.zip (padMax xs ys) +-- | Like 'V.zipWith', except pads the vectors to equal length +-- rather than discarding elements of the longer vector. +zipPadWith :: (Bool -> Bool -> Bool) -> BitVector -> BitVector -> BitVector +zipPadWith f xs ys = uncurry (V.zipWith f) (padMax xs ys) + -- | Discards any 'False' values at the most-significant end of the -- given 'BitVector'. trimLeading :: BitVector -> BitVector trimLeading = V.reverse . V.dropWhile not . V.reverse +infix 4 ==~ +-- | Equality modulo trailing 'False' bits +(==~) :: BitVector -> BitVector -> Bool +(==~) = (==) `on` trimLeading + instance Num BitVector where fromInteger = unpackInteger as + bs = if cout then V.tail sums `V.snoc` True else V.tail sums @@ -84,29 +96,55 @@ | otherwise = 1 instance Bits BitVector where - (.&.) = V.zipWith (&&) - (.|.) = V.zipWith (||) - xor = V.zipWith (/=) - complement = V.map not - shiftL v i = V.replicate i False V.++ v - shiftR = flip V.drop - rotateR v i = high V.++ low + (.&.) = zipPadWith (&&) + + (.|.) = zipPadWith (||) + + xor = zipPadWith (/=) + + complement = V.map not + + shiftL v i = V.replicate i False V.++ v + + shiftR = flip V.drop + + rotateR v i = high V.++ low where (low, high) = V.splitAt i v - rotateL v i = high V.++ low + + rotateL v i = high V.++ low where (low, high) = V.splitAt (V.length v - i) v - bitSize = V.length - isSigned = const False --- | Converts an instance of 'Bits' to a 'BitVector'. --- --- /Note:/ this uses 'bitSize', and will not work for instances which --- do not implement this method, notably 'Integer'. To unpack --- 'Integer' values, use 'unpackInteger'. -unpack :: (Bits a) => a -> BitVector -unpack w = trimLeading $ V.generate (bitSize w) (testBit w) + setBit v i | i < V.length v = V.unsafeUpd v [(i, True)] + | otherwise = V.generate (i+1) f + where f j | i == j = True + | otherwise = testBit v j + clearBit v i | i < V.length v = V.unsafeUpd v [(i, False)] + | otherwise = v + + testBit v i + | Just b <- v V.!? i = b + | otherwise = False + + bit n = V.generate (n+1) (== n) + + bitSizeMaybe = Just . V.length + + bitSize = finiteBitSize + + isSigned = const False + + popCount = V.foldl' (\x b -> if b then x+1 else x) 0 + +instance FiniteBits BitVector where + finiteBitSize = V.length + +-- | Converts an instance of 'FiniteBits' to a 'BitVector'. +unpack :: (FiniteBits a) => a -> BitVector +unpack w = trimLeading $ V.generate (finiteBitSize w) (testBit w) + -- | Converts a 'BitVector' to an instance of 'Bits'. -pack :: (Bits a) => BitVector -> a +pack :: (Num a, Bits a) => BitVector -> a pack v = V.ifoldl' set 0 v where set w i True = w `setBit` i @@ -124,7 +162,7 @@ packInteger = pack unpackInt :: Int -> BitVector -unpackInt = unpack +unpackInt = unpack packInt :: BitVector -> Int -packInt = pack +packInt = pack diff --git a/test/Data/Vector/Bit/Tests.hs b/test/Data/Vector/Bit/Tests.hs --- a/test/Data/Vector/Bit/Tests.hs +++ b/test/Data/Vector/Bit/Tests.hs @@ -1,16 +1,25 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} + +import Data.Bits import Data.Vector.Bit import qualified Data.Vector.Unboxed as V -import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 +import Test.Tasty +import Test.Tasty.TH +import Test.Tasty.QuickCheck hiding ((.&.)) + +instance Arbitrary BitVector where + arbitrary = (unpackInteger . getNonNegative) `fmap` arbitrary + prop_packUnpack :: Int -> Bool prop_packUnpack x | x >= 0 = pack (unpack x) == x | otherwise = True prop_unpackPack :: [Bool] -> Bool -prop_unpackPack xs - | length xs < 64 && (pack (V.fromList xs') :: Int) >= 0 +prop_unpackPack xs + | length xs < 64 && (pack (V.fromList xs') :: Int) >= 0 = unpack (pack (V.fromList xs') :: Int) == V.fromList xs' | otherwise = True where xs' = reverse . dropWhile not . reverse $ xs @@ -29,16 +38,43 @@ prop_absSignum x | x >= 0 = abs (unpack x) * signum (unpack x) == unpack x | otherwise = True -main = defaultMain tests +prop_clearZero :: NonNegative Int -> Bool +prop_clearZero nn = clearBit zeroBits n ==~ zeroBits + where n = getNonNegative nn -tests = [ testGroup "Pack/Unpack" [ - testProperty "pack . unpack" prop_packUnpack - , testProperty "unpack . pack" prop_unpackPack - ] - , testGroup "Num instance" [ - testProperty "+" prop_addCorrect - , testProperty "*" prop_multCorrect - , testProperty "-" prop_subCorrect - , testProperty "abs / signum" prop_absSignum - ] - ] +prop_setZero :: NonNegative Int -> Bool +prop_setZero nn = setBit zeroBits n ==~ bit n + where n = getNonNegative nn + +prop_testZero :: NonNegative Int -> Bool +prop_testZero nn = testBit (zeroBits :: BitVector) n == False + where n = getNonNegative nn + +prop_countZero :: Bool +prop_countZero = popCount (zeroBits :: BitVector) == 0 + +prop_complementInverse :: BitVector -> Bool +prop_complementInverse v = complement (complement v) ==~ v + +prop_orSet :: BitVector -> NonNegative Int -> Bool +prop_orSet v nn = testBit (v .|. bit n) n + where n = getNonNegative nn + +prop_andTest :: BitVector -> NonNegative Int -> Bool +prop_andTest v nn = testBit v n == not (v .&. bit n ==~ zeroBits) + where n = getNonNegative nn + +prop_andClear :: BitVector -> NonNegative Int -> Bool +prop_andClear v nn = clearBit v n ==~ v' .&. complement mask + where n = getNonNegative nn + (v', mask) = padMax v (bit n) + +prop_xorZero :: BitVector -> Bool +prop_xorZero v = v `xor` v ==~ zeroBits + +prop_xorFlip :: BitVector -> NonNegative Int -> Bool +prop_xorFlip v nn = testBit v' n == not (testBit v n) + where v' = v `xor` bit n + n = getNonNegative nn + +main = $(defaultMainGenerator)