hw-bits 0.2.0.1 → 0.2.0.2

raw patch · 11 files changed

+235/−181 lines, 11 filesdep ~hw-primPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: hw-prim

API changes (from Hackage documentation)

Files

• hw-bits.cabal +9/−8
• src/HaskellWorks/Data/Bits/LoBitsSized.hs +2/−1
• src/HaskellWorks/Data/Bits/PackedVector.hs +8/−0
• src/HaskellWorks/Data/Bits/PackedVector/Internal.hs +72/−0
• src/HaskellWorks/Data/Bits/PackedVector/PackedVector64.hs +69/−0
• src/HaskellWorks/Data/Bits/SubWord64Vector.hs +0/−34
• src/HaskellWorks/Data/Bits/SubWord64Vector/Internal.hs +0/−72
• test/HaskellWorks/Data/Bits/PackedVector/InternalSpec.hs +38/−0
• test/HaskellWorks/Data/Bits/PackedVector/PackedVector64Spec.hs +37/−0
• test/HaskellWorks/Data/Bits/SubWord64Vector/InternalSpec.hs +0/−37
• test/HaskellWorks/Data/Bits/SubWord64VectorSpec.hs +0/−29

@@ -1,5 +1,5 @@ name:                   hw-bits-version:                0.2.0.1+version:                0.2.0.2 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-bits#readme@@ -47,15 +47,16 @@                       , 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.PackedVector+                      , HaskellWorks.Data.Bits.PackedVector.Internal+                      , HaskellWorks.Data.Bits.PackedVector.PackedVector64                       , HaskellWorks.Data.Bits.Types.Broadword                       , HaskellWorks.Data.Bits.Types.Builtin                       , HaskellWorks.Data.Bits.Unmatched                       , HaskellWorks.Data.Bits.Word   build-depends:        base                          >= 4          && < 5                       , bytestring-                      , hw-prim                       >= 0.3.0.0+                      , hw-prim                       >= 0.3.0.1                       , parsec                       , safe                       , vector@@ -72,13 +73,13 @@                       , HaskellWorks.Data.Bits.FromBitTextByteStringSpec                       , HaskellWorks.Data.Bits.Log2Spec                       , HaskellWorks.Data.Bits.UnmatchedSpec-                      , HaskellWorks.Data.Bits.SubWord64VectorSpec-                      , HaskellWorks.Data.Bits.SubWord64Vector.InternalSpec+                      , HaskellWorks.Data.Bits.PackedVector.PackedVector64Spec+                      , HaskellWorks.Data.Bits.PackedVector.InternalSpec   build-depends:        base                          >= 4          && < 5                       , bytestring                       , hspec                       , hw-bits-                      , hw-prim                       >= 0.3.0.0+                      , hw-prim                       >= 0.3.0.1                       , QuickCheck                       , vector   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall@@ -97,5 +98,5 @@     Build-Depends:      base                          >= 4          && < 5                       , criterion                       , hw-bits-                      , hw-prim                       >= 0.3.0.0+                      , hw-prim                       >= 0.3.0.1                       , vector

@@ -4,9 +4,10 @@  import Data.Word import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning  class LoBitsSized a where-  loBitsSized :: Int -> a+  loBitsSized :: Count -> a  instance LoBitsSized Word64 where   loBitsSized n = let o = fromIntegral (64 - n) in 0xFFFFFFFFFFFFFFFF .<. o .>. o

@@ -0,0 +1,8 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Bits.PackedVector+    ( module X+    ) where++import           HaskellWorks.Data.Bits.PackedVector.Internal       as X+import           HaskellWorks.Data.Bits.PackedVector.PackedVector64 as X

@@ -0,0 +1,72 @@+module HaskellWorks.Data.Bits.PackedVector.Internal+  ( packBits+  , packBits'+  , unpackBits+  , unpackBits'+  ) where++import           Data.Word+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.FixedBitSize+import           HaskellWorks.Data.Bits.LoBitsSized+import           HaskellWorks.Data.Positioning++{-# ANN module ("HLint: Reduce duplication" :: String) #-}++class Integral a => PackBits a where+  packBits :: Count -> [a] -> [a]+  packBits = packBits' 0 0++  packBits' :: Count -> a -> Count -> [a] -> [a]++class Integral a => UnpackBits a where+  unpackBits :: Int -> Count -> [a] -> [a]+  unpackBits = unpackBits' 0 0++  unpackBits' :: Count -> a -> Int -> Count -> [a] -> [a]++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      = fromIntegral (fillMet - filled) :: Count+          newV        = carry .|. ((w .&. loBitsSized bitMet) .<. fromIntegral filled)+          carryV      = w .>. 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      = fromIntegral (fillMet - filled) :: Count+          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' _ _ _ _ _ = []

@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Bits.PackedVector.PackedVector64+  ( PackedVector64(..)+  , fromList+  , toList+  ) where++import qualified Data.Vector.Storable as DVS+import           Data.Int+import           Data.Word+import           HaskellWorks.Data.AtIndex+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.LoBitsSized+import           HaskellWorks.Data.Bits.PackedVector.Internal+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Unsign+import           Prelude hiding (length)++data PackedVector64 = PackedVector64+    { swBuffer      :: !(DVS.Vector Word64)+    , swBitSize     :: !Word+    , swBufferLen   :: !Int+    } deriving (Eq, Show)++-- empty :: PackedVector64+-- empty =+--   PackedVector64+--   { swBuffer    = DVS.empty+--   , swBufferLen = 0+--   , swBitSize   = 1+--   }++instance Container PackedVector64 where+  type Elem PackedVector64 = Word64++instance Length PackedVector64 where+  length = fromIntegral . swBufferLen+  {-# INLINE length #-}++instance AtIndex PackedVector64 where+  atIndex v i =+    let bitSize     = fromIntegral (swBitSize v) :: Count+        bitIndex    = fromIntegral (swBitSize v) * i+        (q, r)      = bitIndex `quotRem` 64+        vv          = swBuffer v+    in if r <= 64 - fromIntegral bitSize+      then -- Not crossing boundary+        ((vv !!! q) .>. unsign r) .&. loBitsSized bitSize+      else -- Crossing boundary+        let loBitsSize  = 64 - toCount r+            hiBitsSize  = bitSize - loBitsSize+            loBits      = ((vv !!! q) .>. unsign r) .&. loBitsSized loBitsSize+            hiBits      = if r > 64 - fromIntegral bitSize then (vv !!! (q + 1)) .&. loBitsSized hiBitsSize else 0+        in  loBits .|. (hiBits .<. loBitsSize)+  (!!!)       = atIndex+  {-# INLINE (!!!)   #-}+  {-# INLINE atIndex #-}++fromList :: Count -> [Word64] -> PackedVector64+fromList wl ws =+  PackedVector64+  { swBuffer    = DVS.fromList (packBits wl ws)+  , swBufferLen = fromIntegral (length ws)+  , swBitSize   = fromIntegral wl+  }++toList :: PackedVector64 -> [Word64]+toList v = unpackBits (swBufferLen v) (fromIntegral (swBitSize v)) (DVS.toList (swBuffer v))

@@ -1,34 +0,0 @@-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)-    , swBitSize     :: !Word-    , swBufferLen   :: !Int-    } deriving (Eq, Show)---- empty :: SubWord64Vector--- empty =---   SubWord64Vector---   { swBuffer    = DVS.empty---   , swBufferLen = 0---   , swBitSize   = 1---   }----fromList :: Int -> [Word64] -> SubWord64Vector-fromList wl ws =-  SubWord64Vector-  { swBuffer    = DVS.fromList (packBits wl ws)-  , swBufferLen = fromIntegral (length ws)-  , swBitSize   = fromIntegral wl-  }--toList :: SubWord64Vector -> [Word64]-toList v = unpackBits (swBufferLen v) (fromIntegral (swBitSize v)) (DVS.toList (swBuffer v))

@@ -1,72 +0,0 @@-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-import           HaskellWorks.Data.Bits.LoBitsSized--{-# ANN module ("HLint: Reduce duplication" :: String) #-}--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 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' _ _ _ _ _ = []

@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE    ScopedTypeVariables           #-}++module HaskellWorks.Data.Bits.PackedVector.InternalSpec (spec) where++import           Data.Word+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PackedVector.Internal+import           HaskellWorks.Data.Positioning+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++subWordSize :: Count -> Gen Count+subWordSize maxWordSize = choose (1, maxWordSize)++word8OfSize :: Count -> Gen Word8+word8OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++word64OfSize :: Count -> Gen Word64+word64OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++listLen :: Gen Int+listLen = choose (1, 128)++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.PackedVector.InternalSpec" $ do+  it "PackedVector 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 "PackedVector Word64" $+    forAll (subWordSize 64) $ \wSize ->+      forAll listLen $ \len ->+        forAll (vectorOf len (word64OfSize wSize)) $ \ws ->+          unpackBits (length ws) wSize (packBits wSize ws) `shouldBe` ws

@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE    ScopedTypeVariables           #-}++module HaskellWorks.Data.Bits.PackedVector.PackedVector64Spec (spec) where++import           Data.Word+import           HaskellWorks.Data.AtIndex+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PackedVector.PackedVector64+import           HaskellWorks.Data.Positioning+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++subWordSize :: Count -> Gen Count+subWordSize maxWordSize = choose (1, maxWordSize)++word64OfSize :: Count -> Gen Word64+word64OfSize sz = choose (0, 1 .<. fromIntegral sz - 1)++listLen :: Gen Int+listLen = choose (1, 128)++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.PackedVector.PackedVector64Spec" $ do+  it "Round trip from list" $+    forAll (subWordSize 64) $ \wSize ->+      forAll listLen $ \len ->+        forAll (vectorOf len (word64OfSize wSize)) $ \ws ->+          toList (fromList wSize ws) `shouldBe` ws+  it "Round trip from list" $+    forAll (subWordSize 64) $ \wSize ->+      forAll (choose (1, 32 :: Int)) $ \len ->+        forAll (vectorOf len (word64OfSize wSize)) $ \ws ->+          forAll (choose (0, fromIntegral len - 1 :: Position)) $ \i ->+            (fromList wSize ws !!! i) `shouldBe` (ws !!! i)

@@ -1,37 +0,0 @@-{-# 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

@@ -1,29 +0,0 @@-{-# 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