hw-bits 0.1.0.0 → 0.1.0.1
raw patch · 10 files changed
+274/−6 lines, 10 filesdep +safe
Dependencies added: safe
Files
- hw-bits.cabal +8/−1
- src/HaskellWorks/Data/Bits/AllExcess/AllExcess1.hs +18/−1
- src/HaskellWorks/Data/Bits/BitLength.hs +3/−3
- src/HaskellWorks/Data/Bits/BitWise.hs +1/−1
- src/HaskellWorks/Data/Bits/Log2.hs +48/−0
- src/HaskellWorks/Data/Bits/SubWord64Vector.hs +26/−0
- src/HaskellWorks/Data/Bits/SubWord64Vector/Internal.hs +86/−0
- test/HaskellWorks/Data/Bits/Log2Spec.hs +18/−0
- test/HaskellWorks/Data/Bits/SubWord64Vector/InternalSpec.hs +37/−0
- test/HaskellWorks/Data/Bits/SubWord64VectorSpec.hs +29/−0
hw-bits.cabal view
@@ -1,5 +1,5 @@ name: hw-bits-version: 0.1.0.0+version: 0.1.0.1 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-bits#readme@@ -42,9 +42,12 @@ , HaskellWorks.Data.Bits.ElemFixedBitSize , HaskellWorks.Data.Bits.FixedBitSize , HaskellWorks.Data.Bits.FromBitTextByteString+ , HaskellWorks.Data.Bits.Log2 , HaskellWorks.Data.Bits.PopCount , HaskellWorks.Data.Bits.PopCount.PopCount0 , HaskellWorks.Data.Bits.PopCount.PopCount1+ , HaskellWorks.Data.Bits.SubWord64Vector+ , HaskellWorks.Data.Bits.SubWord64Vector.Internal , HaskellWorks.Data.Bits.Types.Broadword , HaskellWorks.Data.Bits.Types.Builtin , HaskellWorks.Data.Bits.Unmatched@@ -53,6 +56,7 @@ , bytestring , hw-prim >= 0.1.0.0 , parsec+ , safe , vector default-language: Haskell2010@@ -65,7 +69,10 @@ other-modules: HaskellWorks.Data.Bits.BitReadSpec , HaskellWorks.Data.Bits.BitWiseSpec , HaskellWorks.Data.Bits.FromBitTextByteStringSpec+ , HaskellWorks.Data.Bits.Log2Spec , HaskellWorks.Data.Bits.UnmatchedSpec+ , HaskellWorks.Data.Bits.SubWord64VectorSpec+ , HaskellWorks.Data.Bits.SubWord64Vector.InternalSpec build-depends: base >= 4 && < 5 , bytestring , hspec
src/HaskellWorks/Data/Bits/AllExcess/AllExcess1.hs view
@@ -3,7 +3,8 @@ module HaskellWorks.Data.Bits.AllExcess.AllExcess1 where import Data.Word-import qualified Data.Vector.Storable as DVS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS import HaskellWorks.Data.Bits.PopCount.PopCount0 import HaskellWorks.Data.Bits.PopCount.PopCount1 @@ -31,6 +32,22 @@ {-# INLINE allExcess1 #-} instance AllExcess1 Word64 where+ allExcess1 w = fromIntegral (popCount1 w) - fromIntegral (popCount0 w)+ {-# INLINE allExcess1 #-}++instance AllExcess1 (DV.Vector Word8) where+ allExcess1 w = fromIntegral (popCount1 w) - fromIntegral (popCount0 w)+ {-# INLINE allExcess1 #-}++instance AllExcess1 (DV.Vector Word16) where+ allExcess1 w = fromIntegral (popCount1 w) - fromIntegral (popCount0 w)+ {-# INLINE allExcess1 #-}++instance AllExcess1 (DV.Vector Word32) where+ allExcess1 w = fromIntegral (popCount1 w) - fromIntegral (popCount0 w)+ {-# INLINE allExcess1 #-}++instance AllExcess1 (DV.Vector Word64) where allExcess1 w = fromIntegral (popCount1 w) - fromIntegral (popCount0 w) {-# INLINE allExcess1 #-}
src/HaskellWorks/Data/Bits/BitLength.hs view
@@ -17,9 +17,9 @@ import qualified Data.Vector as DV import qualified Data.Vector.Storable as DVS import Data.Word+import HaskellWorks.Data.IndexedSeq import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Vector.VectorLike import Prelude as P -- | Number of bits in a value including ones and zeros.@@ -33,11 +33,11 @@ -------------------------------------------------------------------------------- -- Functions -elemBitLength :: (VectorLike v, BitLength (Elem v)) => v -> Count+elemBitLength :: (IndexedSeq v, BitLength (Elem v)) => v -> Count elemBitLength v = bitLength (v !!! 0) {-# INLINE elemBitLength #-} -elemBitEnd :: (VectorLike v, BitLength (Elem v)) => v -> Position+elemBitEnd :: (IndexedSeq v, BitLength (Elem v)) => v -> Position elemBitEnd v = endPosition (v !!! 0) {-# INLINE elemBitEnd #-}
src/HaskellWorks/Data/Bits/BitWise.hs view
@@ -19,9 +19,9 @@ import qualified Data.Vector.Storable as DVS import Data.Word import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.IndexedSeq as IS import HaskellWorks.Data.Naive import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Vector.VectorLike as VL import Prelude as P -- We pervasively use precedence to avoid excessive parentheses, and we use
+ src/HaskellWorks/Data/Bits/Log2.hs view
@@ -0,0 +1,48 @@+module HaskellWorks.Data.Bits.Log2+ ( Log2(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.IndexedSeq++class Log2 a where+ log2 :: a -> Int++log2_64_tab :: DVS.Vector Int+log2_64_tab = DVS.fromList [+ 63, 0, 58, 1, 59, 47, 53, 2,+ 60, 39, 48, 27, 54, 33, 42, 3,+ 61, 51, 37, 40, 49, 18, 28, 20,+ 55, 30, 34, 11, 43, 14, 22, 4,+ 62, 57, 46, 52, 38, 26, 32, 41,+ 50, 36, 17, 19, 29, 10, 13, 21,+ 56, 45, 25, 31, 35, 16, 9, 12,+ 44, 24, 15, 8, 23, 7, 6, 5]++log2_32_tab :: DVS.Vector Int+log2_32_tab = DVS.fromList [+ 0, 9, 1, 10, 13, 21, 2, 29,+ 11, 14, 16, 18, 22, 25, 3, 30,+ 8, 12, 20, 28, 15, 17, 24, 7,+ 19, 27, 23, 6, 26, 5, 4, 31]++instance Log2 Word64 where+ log2 v0 =+ let v1 = v0 .|. (v0 .>. 1) in+ let v2 = v1 .|. (v1 .>. 2) in+ let v3 = v2 .|. (v2 .>. 4) in+ let v4 = v3 .|. (v3 .>. 8) in+ let v5 = v4 .|. (v4 .>. 16) in+ let v6 = v5 .|. (v5 .>. 32) in+ log2_64_tab !!! fromIntegral (((v6 - (v6 .>. 1)) * 0x07EDD5E59A4E28C2) .>. 58)++instance Log2 Word32 where+ log2 v0 =+ let v1 = v0 .|. (v0 .>. 1) in+ let v2 = v1 .|. (v1 .>. 2) in+ let v3 = v2 .|. (v2 .>. 4) in+ let v4 = v3 .|. (v3 .>. 8) in+ let v5 = v4 .|. (v4 .>. 16) in+ log2_32_tab !!! fromIntegral ((v5 * 0x07C4ACDD) .>. 27)
+ src/HaskellWorks/Data/Bits/SubWord64Vector.hs view
@@ -0,0 +1,26 @@+module HaskellWorks.Data.Bits.SubWord64Vector+ ( SubWord64Vector(..)+ , fromList+ , toList+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.SubWord64Vector.Internal++data SubWord64Vector = SubWord64Vector+ { swBuffer :: !(DVS.Vector Word64)+ , swSize :: !Word+ , swBufferLen :: !Int+ } deriving (Eq, Show)++fromList :: Int -> [Word64] -> SubWord64Vector+fromList wl ws =+ SubWord64Vector+ { swBuffer = DVS.fromList (packBits wl ws)+ , swBufferLen = fromIntegral (length ws)+ , swSize = fromIntegral wl+ }++toList :: SubWord64Vector -> [Word64]+toList v = unpackBits (swBufferLen v) (fromIntegral (swSize v)) (DVS.toList (swBuffer v))
+ src/HaskellWorks/Data/Bits/SubWord64Vector/Internal.hs view
@@ -0,0 +1,86 @@+module HaskellWorks.Data.Bits.SubWord64Vector.Internal+ ( loBitsSized+ , packBits+ , packBits'+ , unpackBits+ , unpackBits'+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.FixedBitSize++{-# ANN module ("HLint: Reduce duplication" :: String) #-}++class LoBitsSized a where+ loBitsSized :: Int -> a++class Integral a => PackBits a where+ packBits :: Int -> [a] -> [a]+ packBits = packBits' 0 0++ packBits' :: Int -> a -> Int -> [a] -> [a]++class Integral a => UnpackBits a where+ unpackBits :: Int -> Int -> [a] -> [a]+ unpackBits = unpackBits' 0 0++ unpackBits' :: Int -> a -> Int -> Int -> [a] -> [a]++instance LoBitsSized Word64 where+ loBitsSized n = let o = fromIntegral (64 - n) in 0xFFFFFFFFFFFFFFFF .<. o .>. o++instance LoBitsSized Word32 where+ loBitsSized n = let o = fromIntegral (32 - n) in 0xFFFFFFFF .<. o .>. o++instance LoBitsSized Word16 where+ loBitsSized n = let o = fromIntegral (16 - n) in 0xFFFF .<. o .>. o++instance LoBitsSized Word8 where+ loBitsSized n = let o = fromIntegral (8 - n) in 0xFF .<. o .>. o++instance PackBits Word64 where+ packBits' filled carry bitLen (w:ws) = if fillNeeded < fromIntegral (fixedBitSize carry)+ then packBits' fillNeeded newV bitLen ws+ else newV : packBits' fillLeft carryV bitLen ws+ where fillNeeded = filled + bitLen+ fillMet = fillNeeded `min` fromIntegral (fixedBitSize carry)+ fillLeft = fillNeeded - fillMet+ bitMet = fillMet - filled+ newV = carry .|. ((w .&. loBitsSized bitMet) .<. fromIntegral filled)+ carryV = w .>. fromIntegral bitMet+ packBits' _ carry _ _ = [carry]++instance UnpackBits Word64 where+ unpackBits' _ _ 0 _ _ = []+ unpackBits' filled carry dataLen bitLen ws | filled >= bitLen =+ let result = (carry .&. loBitsSized bitLen) : unpackBits' (filled - bitLen) (carry .>. fromIntegral bitLen) (dataLen - 1) bitLen ws in+ result+ unpackBits' filled carry dataLen bitLen (w:ws) =+ let bitsNeeded = bitLen - filled in+ let newValue = carry .|. ((w .&. loBitsSized bitsNeeded) .<. fromIntegral filled) in+ newValue : unpackBits' (fromIntegral (fixedBitSize carry) - bitsNeeded) (w .>. fromIntegral bitsNeeded) (dataLen - 1) bitLen ws+ unpackBits' _ _ _ _ _ = []++instance PackBits Word8 where+ packBits' filled carry bitLen (w:ws) = if fillNeeded < fromIntegral (fixedBitSize carry)+ then packBits' fillNeeded newV bitLen ws+ else newV : packBits' fillLeft carryV bitLen ws+ where fillNeeded = filled + bitLen+ fillMet = fillNeeded `min` fromIntegral (fixedBitSize carry)+ fillLeft = fillNeeded - fillMet+ bitMet = fillMet - filled+ newV = carry .|. ((w .&. loBitsSized bitMet) .<. fromIntegral filled)+ carryV = w .>. fromIntegral bitMet+ packBits' _ carry _ _ = [carry]++instance UnpackBits Word8 where+ unpackBits' _ _ 0 _ _ = []+ unpackBits' filled carry dataLen bitLen ws | filled >= bitLen =+ (carry .&. loBitsSized bitLen) : unpackBits' (filled - bitLen) (carry .>. fromIntegral bitLen) (dataLen - 1) bitLen ws+ unpackBits' filled carry dataLen bitLen (w:ws) =+ let bitsNeeded = bitLen - filled in+ let newValue = carry .|. ((w .&. loBitsSized bitsNeeded) .<. fromIntegral filled) in+ let result = newValue : unpackBits' (8 - bitsNeeded) (w .>. fromIntegral bitsNeeded) (dataLen - 1) bitLen ws in+ result+ unpackBits' _ _ _ _ _ = []
+ test/HaskellWorks/Data/Bits/Log2Spec.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.Log2Spec (spec) where++import Data.Word+import HaskellWorks.Data.Bits.Log2+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.Log2Spec" $ do+ it "Log2 Word64" $ property $+ \(NonZero (w :: Word64)) -> log2 w == floor (log (fromIntegral w) / log 2 :: Double)+ it "Log2 Word32" $ property $+ \(NonZero (w :: Word32)) -> log2 w == floor (log (fromIntegral w) / log 2 :: Double)
+ test/HaskellWorks/Data/Bits/SubWord64Vector/InternalSpec.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.SubWord64Vector.InternalSpec (spec) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.SubWord64Vector.Internal+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++subWordSize :: Int -> Gen Int+subWordSize maxWordSize = choose (1, maxWordSize)++word8OfSize :: Int -> Gen Word8+word8OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++word64OfSize :: Int -> Gen Word64+word64OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++listLen :: Gen Int+listLen = choose (1, 128)++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.SubWord64Vector.InternalSpec" $ do+ it "SubWord64Vector Word8" $+ forAll (subWordSize 8) $ \wSize ->+ forAll (choose (1, 3)) $ \len ->+ forAll (vectorOf len (word8OfSize wSize)) $ \ws ->+ unpackBits (length ws) wSize (packBits wSize ws) `shouldBe` ws+ it "SubWord64Vector Word64" $+ forAll (subWordSize 64) $ \wSize ->+ forAll listLen $ \len ->+ forAll (vectorOf len (word64OfSize wSize)) $ \ws ->+ unpackBits (length ws) wSize (packBits wSize ws) `shouldBe` ws
+ test/HaskellWorks/Data/Bits/SubWord64VectorSpec.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.SubWord64VectorSpec (spec) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.SubWord64Vector+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++subWordSize :: Int -> Gen Int+subWordSize maxWordSize = choose (1, maxWordSize)++word64OfSize :: Int -> Gen Word64+word64OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++listLen :: Gen Int+listLen = choose (1, 128)++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.SubWord64VectorSpec" $ do+ it "SubWord64Vector Word64" $+ forAll (subWordSize 64) $ \wSize ->+ forAll listLen $ \len ->+ forAll (vectorOf len (word64OfSize wSize)) $ \ws ->+ toList (fromList wSize ws) `shouldBe` ws