bits-bytestring (empty) → 0.1.0.0
raw patch · 6 files changed
+332/−0 lines, 6 filesdep +QuickCheckdep +basedep +bitssetup-changed
Dependencies added: QuickCheck, base, bits, bits-bytestring, bytestring, criterion, hspec
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- bench/BenchmarkSuite.hs +25/−0
- bits-bytestring.cabal +52/−0
- src/Data/Bits/ByteString.hs +132/−0
- test/Spec.hs +91/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michael Carpenter (c) 2016++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 Michael Carpenter 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/BenchmarkSuite.hs view
@@ -0,0 +1,25 @@+import Criterion.Main+import Data.Bits+import Data.Bits.ByteString()+import qualified Data.ByteString as B++zero :: B.ByteString+zero = B.replicate 64 0++bs512 :: B.ByteString+bs512 = B.replicate 64 255++bs1024 :: B.ByteString+bs1024 = B.replicate 128 255++benchBitwiseOperator :: (Int -> B.ByteString) -> [Benchmark]+benchBitwiseOperator f = fmap (\x -> bench (show x) $ whnf f x) ([128,256,512,1024] :: [Int])++main :: IO ()+main = defaultMain+ [ bgroup "AND" [ bench "512" $ whnf ((.&.) zero) bs512 ]+ , bgroup "OR" [ bench "512" $ whnf ((.|.) zero) bs512 ]+ , bgroup "XOR" [ bench "512" $ whnf (xor zero) bs512 ]+ , bgroup "shift" $ benchBitwiseOperator (shift bs1024)+ , bgroup "rotate" $ benchBitwiseOperator (rotate bs1024)+ ]
+ bits-bytestring.cabal view
@@ -0,0 +1,52 @@+name: bits-bytestring+version: 0.1.0.0+synopsis: Bits instance for bytestrings.+description: Please see README.md+homepage: https://github.com/oldmanmike/bits-bytestring+bug-reports: https://github.com/oldmanmike/bits-bytestring/issues+license: BSD3+license-file: LICENSE+author: Michael Carpenter+maintainer: Michael Carpenter <oldmanmike.dev@gmail.com>+copyright: Copyright (C) 2016 Michael Carpenter+category: Data+build-type: Simple+extra-source-files: LICENSE+cabal-version: >=1.10++library+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Data.Bits.ByteString+ build-depends: base >= 4.7 && < 5,+ bits,+ bytestring+ default-language: Haskell2010++test-suite bits-bytestring-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base,+ bits,+ bits-bytestring,+ bytestring,+ hspec,+ QuickCheck+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++benchmark bits-bytestring-bench+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: BenchmarkSuite.hs+ build-depends: base,+ bytestring,+ criterion,+ bits-bytestring+ ghc-options: -Wall -O2+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/oldmanmike/bits-bytestring
+ src/Data/Bits/ByteString.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-------------------------------------------------------------------------------+-- |+-- Module : Data.Bits.ByteString+-- Copyright : (c) 2016 Michael Carpenter+-- License : BSD3+-- Maintainer : Michael Carpenter <oldmanmike.dev@gmail.com>+-- Stability : experimental+-- Portability : portable+--+-------------------------------------------------------------------------------+module Data.Bits.ByteString where++import Data.Bits+import qualified Data.ByteString as B+import Data.Word++instance Bits B.ByteString where++ (.&.) a b = B.pack $ B.zipWith (.&.) a b+ {-# INLINE (.&.) #-}++ (.|.) a b = B.pack $ B.zipWith (.|.) a b+ {-# INLINE (.|.) #-}++ xor a b = B.pack $ B.zipWith xor a b+ {-# INLINE xor #-}++ complement = B.map complement+ {-# INLINE complement #-}++ shift x i+ | i < 0 = x `shiftR` (-i)+ | i > 0 = x `shiftL` i+ | otherwise = x+ {-# INLINE shift #-}++ shiftR bs 0 = bs+ shiftR "" _ = B.empty+ shiftR bs i+ | i `mod` 8 == 0 =+ B.take (B.length bs) $ B.append+ (B.replicate (i `div` 8) 0)+ (B.drop (i `div` 8) bs)+ | i `mod` 8 /= 0 =+ B.pack $ take (B.length bs)+ $ (replicate (i `div` 8) (0 :: Word8))+ ++ (go (i `mod` 8) 0 $ B.unpack (B.take (B.length bs - (i `div` 8)) bs))+ where+ go _ _ [] = []+ go j w1 (w2:wst) = (maskR j w1 w2) : go j w2 wst+ maskR j w1 w2 = (shiftL w1 (8-j)) .|. (shiftR w2 j)+ shiftR _ _ = error "I can't believe you've done this."+ {-# INLINE shiftR #-}++ shiftL bs 0 = bs+ shiftL "" _ = B.empty+ shiftL bs i+ | i `mod` 8 == 0 =+ B.take (B.length bs) $ B.append+ (B.drop (i `div` 8) bs)+ (B.replicate (i `div` 8) 0)+ | i `mod` 8 /= 0 =+ B.pack $ drop ((i `div` 8) - B.length bs)+ $ (tail (go (i `mod` 8) 0 $ B.unpack (B.drop (i `div` 8) bs)))+ ++ (replicate (i `div` 8) 0)+ where+ go j w1 [] = [shiftL w1 j]+ go j w1 (w2:wst) = (maskL j w1 w2) : go j w2 wst+ maskL j w1 w2 = (shiftL w1 j) .|. (shiftR w2 (8-j))+ shiftL _ _ = error "I can't believe you've done this."+ {-# INLINE shiftL #-}++ rotate x i+ | i < 0 = x `rotateR` (-i)+ | i > 0 = x `rotateL` i+ | otherwise = x+ {-# INLINE rotate #-}++ rotateR bs 0 = bs+ rotateR bs i+ | B.length bs == 0 = B.empty+ | B.length bs == 1 = B.singleton (rotateR (bs `B.index` 0) i)+ | B.length bs > 1 = do+ let shiftedWords =+ B.append+ (B.drop (nWholeWordsToShift i) bs)+ (B.take (nWholeWordsToShift i) bs)+ let tmpShiftedBits = (shiftR shiftedWords (i `mod` 8))+ let rotatedBits = (shiftL (B.last shiftedWords) (8 - (i `mod` 8))) .|. (B.head tmpShiftedBits)+ rotatedBits `B.cons` (B.tail tmpShiftedBits)+ where+ nWholeWordsToShift n = (B.length bs - (n `div` 8))+ rotateR _ _ = error "I can't believe you've done this."+ {-# INLINE rotateR #-}++ rotateL bs 0 = bs+ rotateL bs i+ | B.length bs == 0 = B.empty+ | B.length bs == 1 = B.singleton (rotateL (bs `B.index` 0) i)+ | i `mod` 8 == 0 = B.append+ (B.drop (i `div` 8) bs)+ (B.take (i `div` 8) bs)+ | B.length bs > 1 = do+ let shiftedWords =+ B.append+ (B.drop (i `div` 8) bs)+ (B.take (i `div` 8) bs)+ let tmpShiftedBits = (shiftL shiftedWords (i `mod` 8))+ let rotatedBits = (shiftR (B.head shiftedWords) (8 - (i `mod` 8))) .|. (B.last tmpShiftedBits)+ (B.init tmpShiftedBits) `B.snoc` rotatedBits+ rotateL _ _ = error "I can't believe you've done this."+ {-# INLINE rotateL #-}++ bitSize x = 8 * B.length x+ {-# INLINE bitSize #-}++ bitSizeMaybe x = Just (8 * B.length x)+ {-# INLINE bitSizeMaybe #-}++ isSigned _ = False+ {-# INLINE isSigned #-}++ testBit x i = testBit (B.index x (B.length x - (i `div` 8) - 1)) (i `mod` 8)+ {-# INLINE testBit #-}++ bit i = (bit $ mod i 8) `B.cons` (B.replicate (div i 8) (255 :: Word8))+ {-# INLINE bit #-}++ popCount x = sum $ map popCount $ B.unpack x+ {-# INLINE popCount #-}
+ test/Spec.hs view
@@ -0,0 +1,91 @@+import Data.Bits+import Data.Bits.ByteString+import qualified Data.ByteString as B+import Test.Hspec+import Test.QuickCheck hiding ((.&.))++instance Arbitrary B.ByteString where+ arbitrary = fmap B.pack (listOf arbitrary)++prop_IdentityAND :: B.ByteString -> Bool+prop_IdentityAND a = a == (a .&. a)++prop_CommutativityAND :: B.ByteString -> B.ByteString -> Bool+prop_CommutativityAND a b = (a .&. b) == (b .&. a)++prop_AssociativityAND :: B.ByteString -> B.ByteString -> B.ByteString -> Bool+prop_AssociativityAND a b c = (a .&. (b .&. c)) == ((a .&. b) .&. c)++prop_IdentityOR :: B.ByteString -> Bool+prop_IdentityOR a = a == (a .|. (B.replicate (B.length a) 0))++prop_CommutativityOR :: B.ByteString -> B.ByteString -> Bool+prop_CommutativityOR a b = (a .|. b) == (b .|. a)++prop_AssociativityOR :: B.ByteString -> B.ByteString -> B.ByteString -> Bool+prop_AssociativityOR a b c = (a .|. (b .|. c)) == ((a .|. b) .|. c)++prop_IdentityXOR :: B.ByteString -> Bool+prop_IdentityXOR a = a == (a `xor` (B.replicate (B.length a) 0))++prop_CommutativityXOR :: B.ByteString -> B.ByteString -> Bool+prop_CommutativityXOR a b = (a `xor` b) == (b `xor` a)++prop_AssociativityXOR :: B.ByteString -> B.ByteString -> B.ByteString -> Bool+prop_AssociativityXOR a b c = (a `xor` (b `xor` c)) == ((a `xor` b) `xor` c)++prop_IdentityComplement :: B.ByteString -> Bool+prop_IdentityComplement x = x == complement (complement x)++prop_ConstantLengthShiftL :: B.ByteString -> Int -> Bool+prop_ConstantLengthShiftL x i = (B.length x) == (B.length $ shiftL x i)++prop_ConstantLengthShiftR :: B.ByteString -> Int -> Bool+prop_ConstantLengthShiftR x i = (B.length x) == (B.length $ shiftR x i)++prop_ConstantLengthShift :: B.ByteString -> Int -> Bool+prop_ConstantLengthShift x i = (B.length x) == (B.length $ shift x i)++prop_ConstantLengthRotateL :: B.ByteString -> Int -> Bool+prop_ConstantLengthRotateL x i = (B.length x) == (B.length $ rotateL x i)++prop_ConstantLengthRotateR :: B.ByteString -> Int -> Bool+prop_ConstantLengthRotateR x i = (B.length x) == (B.length $ rotateR x i)++prop_ConstantLengthRotate :: B.ByteString -> Int -> Bool+prop_ConstantLengthRotate x i = (B.length x) == (B.length $ rotate x i)++prop_IdentityRotate :: B.ByteString -> Int -> Bool+prop_IdentityRotate x i = x == rotateR (rotateL x i) i++main :: IO ()+main = hspec $ do+ describe "AND" $ do+ context "Should have the following properties:" $ do+ it "Identity" $ property prop_IdentityAND+ it "Commutativity" $ property prop_CommutativityAND+ it "Associativity" $ property prop_AssociativityAND+ describe "OR" $ do+ context "Should have the following properties:" $ do+ it "Identity" $ property prop_IdentityOR+ it "Commutativity" $ property prop_CommutativityOR+ it "Associativity" $ property prop_AssociativityOR+ describe "XOR" $ do+ context "Should have the following properties:" $ do+ it "Identity" $ property prop_IdentityXOR+ it "Commutativity" $ property prop_CommutativityXOR+ it "Associativity" $ property prop_AssociativityXOR+ describe "Complement" $ do+ context "Should have the following properties:" $ do+ it "Identity" $ property prop_IdentityComplement+ describe "Shift" $ do+ context "Should have the following properties:" $ do+ it "Length should not change on ShiftL" $ property prop_ConstantLengthShiftL+ it "Length should not change on ShiftR" $ property prop_ConstantLengthShiftR+ it "Length should not change on Shift" $ property prop_ConstantLengthShift+ describe "Rotate" $ do+ context "Should have the following properties:" $ do+ it "Length should not change on RotateL" $ property prop_ConstantLengthRotateL+ it "Length should not change on RotateR" $ property prop_ConstantLengthRotateR+ it "Length should not change on Rotate" $ property prop_ConstantLengthRotate+ it "Identity" $ property prop_IdentityRotate