diff --git a/hw-prim.cabal b/hw-prim.cabal --- a/hw-prim.cabal +++ b/hw-prim.cabal @@ -1,31 +1,30 @@ cabal-version: 2.2 -name: hw-prim -version: 0.6.2.38 -synopsis: Primitive functions and data types -description: Primitive functions and data types. -category: Data -stability: Experimental -homepage: http://github.com/haskell-works/hw-prim#readme -bug-reports: https://github.com/haskell-works/hw-prim/issues -author: John Ky -maintainer: newhoggy@gmail.com -copyright: 2016-2019 John Ky -license: BSD-3-Clause -license-file: LICENSE -tested-with: GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 -build-type: Simple -extra-source-files: - README.md +name: hw-prim +version: 0.6.2.39 +synopsis: Primitive functions and data types +description: Primitive functions and data types. +category: Data +stability: Experimental +homepage: http://github.com/haskell-works/hw-prim#readme +bug-reports: https://github.com/haskell-works/hw-prim/issues +author: John Ky +maintainer: newhoggy@gmail.com +copyright: 2016-2019 John Ky +license: BSD-3-Clause +license-file: LICENSE +tested-with: GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 +build-type: Simple +extra-source-files: README.md source-repository head - type: git - location: https://github.com/haskell-works/hw-prim + type: git + location: https://github.com/haskell-works/hw-prim flag bounds-checking-enabled - description: Enable bmi2 instruction set - manual: False - default: False + description: Enable bmi2 instruction set + manual: False + default: False common base { build-depends: base >= 4 && < 5 } @@ -36,7 +35,7 @@ common directory { build-depends: directory >= 1.2 && < 1.4 } common exceptions { build-depends: exceptions >= 0.8 && < 0.11 } common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.6 } -common hedgehog { build-depends: hedgehog >= 0.5 && < 1.1 } +common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } common hspec { build-depends: hspec >= 2.4 && < 2.8 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } common mmap { build-depends: mmap >= 0.5 && < 0.6 } @@ -46,122 +45,117 @@ common unliftio-core { build-depends: unliftio-core >= 0.1.2.0 && < 0.2 } common common - default-language: Haskell2010 - ghc-options: -Wall -O2 -msse4.2 + default-language: Haskell2010 + ghc-options: -Wall -O2 -msse4.2 if flag(bounds-checking-enabled) - cpp-options: -DBOUNDS_CHECKING_ENABLED + cpp-options: -DBOUNDS_CHECKING_ENABLED library - import: base - , common - , bytestring - , deepseq - , ghc-prim - , mmap - , semigroups - , transformers - , unliftio-core - , vector - exposed-modules: - HaskellWorks.Control.Monad.Lazy - HaskellWorks.Data.AtIndex - HaskellWorks.Data.Branchless - HaskellWorks.Data.ByteString - HaskellWorks.Data.ByteString.Builder - HaskellWorks.Data.ByteString.Lazy - HaskellWorks.Data.Char - HaskellWorks.Data.Char.IsChar - HaskellWorks.Data.Concat - HaskellWorks.Data.Cons - HaskellWorks.Data.Container - HaskellWorks.Data.Decode - HaskellWorks.Data.Drop - HaskellWorks.Data.Empty - HaskellWorks.Data.Filter - HaskellWorks.Data.Foldable - HaskellWorks.Data.FromByteString - HaskellWorks.Data.FromForeignRegion - HaskellWorks.Data.FromString - HaskellWorks.Data.Generate - HaskellWorks.Data.Head - HaskellWorks.Data.Length - HaskellWorks.Data.Naive - HaskellWorks.Data.Null - HaskellWorks.Data.Ops - HaskellWorks.Data.Positioning - HaskellWorks.Data.Product - HaskellWorks.Data.Search - HaskellWorks.Data.Sign - HaskellWorks.Data.Snoc - HaskellWorks.Data.Take - HaskellWorks.Data.TreeCursor - HaskellWorks.Data.Uncons - HaskellWorks.Data.Unsign - HaskellWorks.Data.Unsnoc - HaskellWorks.Data.Vector.AsVector64 - HaskellWorks.Data.Vector.AsVector64ns - HaskellWorks.Data.Vector.AsVector64s - HaskellWorks.Data.Vector.AsVector8 - HaskellWorks.Data.Vector.AsVector8ns - HaskellWorks.Data.Vector.AsVector8s - HaskellWorks.Data.Vector.BoxedVectorLike - HaskellWorks.Data.Vector.Storable - HaskellWorks.Data.Vector.StorableVectorLike - HaskellWorks.Data.Word - HaskellWorks.Foreign - other-modules: Paths_hw_prim - autogen-modules: Paths_hw_prim - hs-source-dirs: src - other-extensions: AllowAmbiguousTypes + import: base + , common + , bytestring + , deepseq + , ghc-prim + , mmap + , semigroups + , transformers + , unliftio-core + , vector + exposed-modules: HaskellWorks.Control.Monad.Lazy + HaskellWorks.Data.AtIndex + HaskellWorks.Data.Branchless + HaskellWorks.Data.ByteString + HaskellWorks.Data.ByteString.Builder + HaskellWorks.Data.ByteString.Lazy + HaskellWorks.Data.Char + HaskellWorks.Data.Char.IsChar + HaskellWorks.Data.Concat + HaskellWorks.Data.Cons + HaskellWorks.Data.Container + HaskellWorks.Data.Decode + HaskellWorks.Data.Drop + HaskellWorks.Data.Empty + HaskellWorks.Data.Filter + HaskellWorks.Data.Foldable + HaskellWorks.Data.FromByteString + HaskellWorks.Data.FromForeignRegion + HaskellWorks.Data.FromString + HaskellWorks.Data.Generate + HaskellWorks.Data.Head + HaskellWorks.Data.Length + HaskellWorks.Data.Naive + HaskellWorks.Data.Null + HaskellWorks.Data.Ops + HaskellWorks.Data.Positioning + HaskellWorks.Data.Product + HaskellWorks.Data.Search + HaskellWorks.Data.Sign + HaskellWorks.Data.Snoc + HaskellWorks.Data.Take + HaskellWorks.Data.TreeCursor + HaskellWorks.Data.Uncons + HaskellWorks.Data.Unsign + HaskellWorks.Data.Unsnoc + HaskellWorks.Data.Vector.AsVector64 + HaskellWorks.Data.Vector.AsVector64ns + HaskellWorks.Data.Vector.AsVector64s + HaskellWorks.Data.Vector.AsVector8 + HaskellWorks.Data.Vector.AsVector8ns + HaskellWorks.Data.Vector.AsVector8s + HaskellWorks.Data.Vector.BoxedVectorLike + HaskellWorks.Data.Vector.Storable + HaskellWorks.Data.Vector.StorableVectorLike + HaskellWorks.Data.Word + HaskellWorks.Foreign + other-modules: Paths_hw_prim + autogen-modules: Paths_hw_prim + hs-source-dirs: src test-suite hw-prim-test - import: base - , common - , QuickCheck - , bytestring - , directory - , exceptions - , hedgehog - , hspec - , hw-hspec-hedgehog - , mmap - , semigroups - , transformers - , vector - type: exitcode-stdio-1.0 - main-is: Spec.hs - other-modules: - HaskellWorks.Data.ByteStringSpec - HaskellWorks.Data.FoldableSpec - HaskellWorks.Data.FromByteStringSpec - HaskellWorks.Data.FromForeignRegionSpec - HaskellWorks.Data.SearchSpec - HaskellWorks.Data.Vector.AsVector64nsSpec - HaskellWorks.Data.Vector.AsVector64sSpec - HaskellWorks.Data.Vector.AsVector8nsSpec - HaskellWorks.Data.Vector.AsVector8sSpec - HaskellWorks.Data.Vector.StorableSpec - Paths_hw_prim - autogen-modules: Paths_hw_prim - build-depends: hw-prim - hs-source-dirs: test - other-extensions: AllowAmbiguousTypes - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-tool-depends: hspec-discover:hspec-discover + import: base + , common + , QuickCheck + , bytestring + , directory + , exceptions + , hedgehog + , hspec + , hw-hspec-hedgehog + , mmap + , semigroups + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: HaskellWorks.Data.ByteStringSpec + HaskellWorks.Data.FoldableSpec + HaskellWorks.Data.FromByteStringSpec + HaskellWorks.Data.FromForeignRegionSpec + HaskellWorks.Data.SearchSpec + HaskellWorks.Data.Vector.AsVector64nsSpec + HaskellWorks.Data.Vector.AsVector64sSpec + HaskellWorks.Data.Vector.AsVector8nsSpec + HaskellWorks.Data.Vector.AsVector8sSpec + HaskellWorks.Data.Vector.StorableSpec + Paths_hw_prim + autogen-modules: Paths_hw_prim + build-depends: hw-prim + hs-source-dirs: test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: hspec-discover:hspec-discover benchmark bench - import: base - , common - , bytestring - , criterion - , mmap - , semigroups - , transformers - , vector - type: exitcode-stdio-1.0 - main-is: Main.hs - other-modules: Paths_hw_prim - hs-source-dirs: bench - build-depends: hw-prim - other-extensions: AllowAmbiguousTypes - autogen-modules: Paths_hw_prim + import: base + , common + , bytestring + , criterion + , mmap + , semigroups + , transformers + , vector + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Paths_hw_prim + hs-source-dirs: bench + build-depends: hw-prim + autogen-modules: Paths_hw_prim diff --git a/src/HaskellWorks/Data/ByteString.hs b/src/HaskellWorks/Data/ByteString.hs --- a/src/HaskellWorks/Data/ByteString.hs +++ b/src/HaskellWorks/Data/ByteString.hs @@ -8,6 +8,7 @@ , ToByteString(..) , ToByteStrings(..) , mmap + , padded , rechunk , rechunkPadded , resegment @@ -219,3 +220,7 @@ (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filepath IO.ReadOnly Nothing let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size return bs + +padded :: Int -> BS.ByteString -> BS.ByteString +padded n v = v <> BS.replicate ((n - BS.length v) `max` 0) 0 +{-# INLINE padded #-} diff --git a/src/HaskellWorks/Data/Vector/Storable.hs b/src/HaskellWorks/Data/Vector/Storable.hs --- a/src/HaskellWorks/Data/Vector/Storable.hs +++ b/src/HaskellWorks/Data/Vector/Storable.hs @@ -108,20 +108,21 @@ construct64UnzipN :: Int -> [(BS.ByteString, BS.ByteString)] -> (DVS.Vector Word64, DVS.Vector Word64) construct64UnzipN nBytes xs = (DVS.unsafeCast ibv, DVS.unsafeCast bpv) where [ibv, bpv] = DVS.createT $ do - let nW64s = (nBytes + 7) `div` 8 - ibmv <- DVSM.new nW64s - bpmv <- DVSM.new nW64s + let nW8s = (nBytes + 7) `div` 8 * 8 + ibmv <- DVSM.new nW8s + bpmv <- DVSM.new nW8s (ibmvRemaining, bpmvRemaining) <- go ibmv bpmv xs - return - [ DVSM.take (((DVSM.length ibmv - ibmvRemaining) `div` 8) * 8) ibmv - , DVSM.take (((DVSM.length bpmv - bpmvRemaining) `div` 8) * 8) bpmv - ] + let ibl = ((DVSM.length ibmv - ibmvRemaining + 7) `div` 8) * 8 + let bpl = ((DVSM.length bpmv - bpmvRemaining + 7) `div` 8) * 8 + return [ DVSM.take ibl ibmv, DVSM.take bpl bpmv] go :: DVSM.MVector s Word8 -> DVSM.MVector s Word8 -> [(BS.ByteString, BS.ByteString)] -> ST s (Int, Int) go ibmv bpmv ((ib, bp):ys) = do DVS.copy (DVSM.take (BS.length ib) ibmv) (asVector8 ib) DVS.copy (DVSM.take (BS.length bp) bpmv) (asVector8 bp) go (DVSM.drop (BS.length ib) ibmv) (DVSM.drop (BS.length bp) bpmv) ys go ibmv bpmv [] = do - DVSM.set (DVSM.take 8 ibmv) 0 - DVSM.set (DVSM.take 8 bpmv) 0 - return (DVSM.length (DVSM.drop 8 ibmv), DVSM.length (DVSM.drop 8 bpmv)) + let ibl = DVSM.length ibmv `mod` 8 + let bpl = DVSM.length bpmv `mod` 8 + DVSM.set (DVSM.take ibl ibmv) 0 + DVSM.set (DVSM.take bpl bpmv) 0 + return (DVSM.length (DVSM.drop ibl ibmv), DVSM.length (DVSM.drop bpl bpmv)) diff --git a/test/HaskellWorks/Data/Vector/StorableSpec.hs b/test/HaskellWorks/Data/Vector/StorableSpec.hs --- a/test/HaskellWorks/Data/Vector/StorableSpec.hs +++ b/test/HaskellWorks/Data/Vector/StorableSpec.hs @@ -6,15 +6,18 @@ ( spec ) where -import Control.Monad.ST (ST) -import Data.Vector.Storable (Storable) +import Control.Monad.ST (ST) +import Data.Vector.Storable (Storable) +import HaskellWorks.Data.Vector.Storable (construct64UnzipN) import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec +import qualified Data.ByteString as BS import qualified Data.List as L import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Storable.Mutable as DVSM +import qualified HaskellWorks.Data.ByteString as BS import qualified HaskellWorks.Data.Vector.Storable as DVS import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R @@ -36,6 +39,23 @@ let (bs, cs) = DVS.construct2N (length as) stepb (length as * 2) stepc as DVS.fromList as === bs DVS.fromList (dupList as) === cs + describe "construct64UnzipN" $ do + it "property" $ requireProperty $ do + abss <- forAll $ G.list (R.linear 1 8) $ (,) + <$> (fmap BS.pack (G.list (R.linear 1 8) (G.word8 R.constantBounded))) + <*> (fmap BS.pack (G.list (R.linear 1 8) (G.word8 R.constantBounded))) + ass <- forAll $ pure $ fmap fst abss + bss <- forAll $ pure $ fmap snd abss + as <- forAll $ pure $ mconcat ass + bs <- forAll $ pure $ mconcat bss + al <- forAll $ pure $ BS.length (mconcat ass) + bl <- forAll $ pure $ BS.length (mconcat bss) + len <- forAll $ pure $ al + bl + let res = construct64UnzipN len (zip ass bss) + let ra = BS.toByteString (fst res) + let rb = BS.toByteString (snd res) + ra === BS.padded ((BS.length as + 7) `div` 8 * 8) as + rb === BS.padded ((BS.length bs + 7) `div` 8 * 8) bs dupList :: [a] -> [a] dupList (a:as) = (a:a:dupList as)