hw-packed-vector (empty) → 0.0.0.1
raw patch · 10 files changed
+317/−0 lines, 10 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, hspec, hw-bits, hw-int, hw-packed-vector, hw-prim, hw-string-parse, safe, vector
Files
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
- hw-packed-vector.cabal +53/−0
- src/HaskellWorks/Data/PackedVector.hs +8/−0
- src/HaskellWorks/Data/PackedVector/Internal.hs +72/−0
- src/HaskellWorks/Data/PackedVector/PackedVector64.hs +70/−0
- test/HaskellWorks/Data/PackedVector/InternalSpec.hs +38/−0
- test/HaskellWorks/Data/PackedVector/PackedVector64Spec.hs +37/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (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 Author name here 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 @@+# hw-packed-vector+[](https://circleci.com/gh/haskell-works/hw-packed-vector/tree/0-branch)++A vector that stores words of equal size between 1 to 64 inclusive in memory contiguously+with efficient lookup.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hw-packed-vector.cabal view
@@ -0,0 +1,53 @@+name: hw-packed-vector+version: 0.0.0.1+synopsis: Packed Vector+description: Please see README.md+homepage: http://github.com/haskell-works/hw-packed-vector#readme+license: BSD3+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+category: Data, Vector+stability: Experimental+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.22++library+ hs-source-dirs: src+ exposed-modules: HaskellWorks.Data.PackedVector+ , HaskellWorks.Data.PackedVector.Internal+ , HaskellWorks.Data.PackedVector.PackedVector64+ build-depends: base >= 4 && < 5+ , bytestring+ , hw-bits >= 0.4.0.0+ , hw-int >= 0.0.0.1+ , hw-prim >= 0.4.0.0+ , hw-string-parse >= 0.0.0.1+ , safe+ , vector++ default-language: Haskell2010+ ghc-options: -Wall -O2 -msse4.2++test-suite hw-packed-vector-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.PackedVector.PackedVector64Spec+ , HaskellWorks.Data.PackedVector.InternalSpec+ build-depends: base >= 4 && < 5+ , bytestring+ , hspec+ , hw-bits >= 0.4.0.0+ , hw-packed-vector+ , hw-prim >= 0.4.0.0+ , QuickCheck+ , vector+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-packed-vector
+ src/HaskellWorks/Data/PackedVector.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.PackedVector+ ( module X+ ) where++import HaskellWorks.Data.PackedVector.Internal as X+import HaskellWorks.Data.PackedVector.PackedVector64 as X
+ src/HaskellWorks/Data/PackedVector/Internal.hs view
@@ -0,0 +1,72 @@+module HaskellWorks.Data.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' _ _ _ _ _ = []
+ src/HaskellWorks/Data/PackedVector/PackedVector64.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.PackedVector.PackedVector64+ ( PackedVector64(..)+ , empty+ , 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.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))
+ test/HaskellWorks/Data/PackedVector/InternalSpec.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.PackedVector.InternalSpec (spec) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.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.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
+ test/HaskellWorks/Data/PackedVector/PackedVector64Spec.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.PackedVector.PackedVector64Spec (spec) where++import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.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.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)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}