bit-vector (empty) → 0.1.0

raw patch · 6 files changed

+250/−0 lines, 6 filesdep +QuickCheckdep +basedep +bit-vectorsetup-changed

Dependencies added: QuickCheck, base, bit-vector, test-framework, test-framework-quickcheck2, vector

Files

LICENSE +30/−0
README.md +6/−0
Setup.hs +2/−0
bit-vector.cabal +38/−0
src/Data/Vector/Bit.hs +130/−0
test/Data/Vector/Bit/Tests.hs +44/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2011, Adam C. Foltzer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Adam C. Foltzer nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,6 @@+## bit-vector ##++This is a dead-simple bit vector package for Haskell. It represents+bit vectors as `Data.Vector.Unboxed` vectors of `Bool`s, and provides+`Num` and `Bits` instances that interpret the vectors as unsigned+integers.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ bit-vector.cabal view

@@ -0,0 +1,38 @@+Name:                bit-vector+Version:             0.1.0+Synopsis:            Simple bit vectors for Haskell+Homepage:            https://github.com/acfoltzer/bit-vector+Bug-reports:         https://github.com/acfoltzer/bit-vector/issues+License:             BSD3+License-file:        LICENSE+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++Library+  Exposed-modules:   Data.Vector.Bit+  Hs-source-dirs:    src+  Build-depends:     base == 4.*,+                     vector == 0.9.*+  ghc-options:       -Wall+                     -- orphans are kind of the point+                     -fno-warn-orphans+                     +Test-Suite Tests+  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.*,+                     bit-vector++source-repository head+  type:     git+  location: git://github.com/acfoltzer/bit-vector.git

+ src/Data/Vector/Bit.hs view

@@ -0,0 +1,130 @@+{- |++Module      :  Data.Vector.Bit+Description :  Simple bit vectors for Haskell+Copyright   :  (c) Adam C. Foltzer 2011+License     :  BSD3++Maintainer  :  acfoltzer@gmail.com+Stability   :  experimental+Portability :  non-portable++-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns #-}++module Data.Vector.Bit (+  -- * Bit vectors+  BitVector,++  -- * Conversions+  +  -- ** To and from other 'Bits' instances+  unpack, pack,++  -- ** Specialized conversions+  unpackInteger, packInteger, unpackInt, packInt,++  -- * Utilities+  pad, padMax, zipPad, trimLeading+  )++where++import Data.Bits+import qualified Data.Vector.Unboxed as V++-- | A 'BitVector' is a little-endian 'V.Vector' of+-- 'Bool's.+type BitVector = V.Vector Bool++-- | Pads a 'BitVector' to the specified length by adding a vector of+-- 'False' values to the most-significant end.+pad :: Int -> BitVector -> BitVector+pad i v = v V.++ V.replicate (i - V.length v) False++-- | Pads two 'BitVector's to the length of the longest vector. If the+-- vectors are the same length, 'padMax' does nothing.+padMax :: BitVector -> BitVector -> (BitVector, BitVector)+padMax xs ys = (padlen xs, padlen ys)+  where+    padlen = pad $ max (V.length xs) (V.length ys)++-- | Like 'V.zip', except pads the vectors to equal length+-- rather than discarding elements of the longer vector.+zipPad :: BitVector -> BitVector -> V.Vector (Bool, Bool)+zipPad xs ys = uncurry V.zip (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++instance Num BitVector where+  fromInteger = unpackInteger+  as + bs = if cout then V.tail sums `V.snoc` True else V.tail sums+    where+      cout            = V.last carries+      (sums, carries) = V.unzip sumsAndCarries+      sumsAndCarries  = V.scanl' fullAdd (False, False) (zipPad as bs)+      fullAdd (_, cin) (a, b) = ((a /= b) /= cin, (a && b) || (cin && (a /= b)))+  as * bs = trimLeading (sum partials)+    where+      partials = zipWith shiftMult (V.toList as) [0 ..]+      shiftMult True i  = bs `shiftL` i+      shiftMult False _ = V.empty+  as - bs = trimLeading $ V.take (V.length as') (rawSum + 1)+    where+      rawSum     = as' + complement bs'+      (as', bs') = padMax as bs+  abs = id+  signum v | V.null v  = 0+           | 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+    where (low, high) = V.splitAt i v+  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)++-- | Converts a 'BitVector' to an instance of 'Bits'.+pack :: (Bits a) => BitVector -> a+pack v = V.ifoldl' set 0 v+  where+    set w i True = w `setBit` i+    set w _ _    = w++unpackInteger :: Integer -> BitVector+unpackInteger = V.unfoldr f+  where+    f (flip divMod 2 -> (0, 0)) = Nothing+    f (flip divMod 2 -> (q, 0)) = Just (False, q)+    f (flip divMod 2 -> (q, 1)) = Just (True, q)+    f _                         = error "unexpected remainder when unpacking"++packInteger :: BitVector -> Integer+packInteger = pack++unpackInt :: Int -> BitVector+unpackInt = unpack ++packInt :: BitVector -> Int+packInt = pack

+ test/Data/Vector/Bit/Tests.hs view

@@ -0,0 +1,44 @@+import Data.Vector.Bit+import qualified Data.Vector.Unboxed as V+import Test.QuickCheck+import Test.Framework+import Test.Framework.Providers.QuickCheck2++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 +    = unpack (pack (V.fromList xs') :: Int) == V.fromList xs'+    | otherwise = True+  where xs' = reverse . dropWhile not . reverse $ xs++prop_addCorrect :: Int -> Int -> Bool+prop_addCorrect x y = x + y == pack (unpack x + unpack y)++prop_multCorrect :: Int -> Int -> Bool+prop_multCorrect x y = x * y == pack (unpack x * unpack y)++prop_subCorrect :: Int -> Int -> Bool+prop_subCorrect x y | x >= y = x - y == pack (unpack x - unpack y)+                    | otherwise = True++prop_absSignum :: Int -> Bool+prop_absSignum x | x >= 0 = abs (unpack x) * signum (unpack x) == unpack x+                 | otherwise = True++main = defaultMain tests++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+                        ]+        ]