bit-vector 0.1.0 → 0.2.0

raw patch · 3 files changed

+128/−53 lines, 3 filesdep +tastydep +tasty-quickcheckdep +tasty-thdep −test-frameworkdep −test-framework-quickcheck2dep ~QuickCheckdep ~basedep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty, tasty-quickcheck, tasty-th

Dependencies removed: test-framework, test-framework-quickcheck2

Dependency ranges changed: QuickCheck, base, vector

API changes (from Hackage documentation)

Files

• bit-vector.cabal +13/−12
• src/Data/Vector/Bit.hs +62/−24
• test/Data/Vector/Bit/Tests.hs +53/−17

@@ -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

@@ -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

@@ -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)