hw-rankselect 0.12.0.0 → 0.12.0.1

raw patch · 5 files changed

+72/−15 lines, 5 filesnew-uploaderPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• bench/Main.hs +30/−8
• hw-rankselect.cabal +2/−2
• src/HaskellWorks/Data/RankSelect/CsPoppy.hs +2/−3
• src/HaskellWorks/Data/RankSelect/CsPoppy/Internal.hs +28/−0
• test/HaskellWorks/Data/RankSelect/CsPoppy/InternalSpec.hs +10/−2

@@ -6,15 +6,18 @@ import Control.Monad import Criterion.Main import Data.List+import Data.Word import HaskellWorks.Data.Bits.PopCount.PopCount1 import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.RankSelect.CsPoppy+import HaskellWorks.Data.RankSelect.CsPoppy.Internal import HaskellWorks.Data.RankSelect.Poppy512 import System.Directory import System.Environment +import qualified Data.Vector.Storable                  as DVS import qualified HaskellWorks.Data.RankSelect.CsPoppy  as CS import qualified HaskellWorks.Data.RankSelect.Poppy512 as P512 @@ -93,16 +96,35 @@     let !_ = select1 msbs 1     return () +benchMakeCsPoppyBlocks1 :: IO [Benchmark]+benchMakeCsPoppyBlocks1 = do+  entries <- listDirectory "data"+  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries+  return (mkBenchmark <$> files)+  where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(v :: DVS.Vector Word64) -> bgroup filename+          [ bench "makeCsPoppyBlocks1"  (whnf makeCsPoppyBlocks1 v)+          ]++benchMakeCsPoppyBlocks2 :: IO [Benchmark]+benchMakeCsPoppyBlocks2 = do+  entries <- listDirectory "data"+  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries+  return (mkBenchmark <$> files)+  where mkBenchmark filename = env (mmapFromForeignRegion filename) $ \(v :: DVS.Vector Word64) -> bgroup filename+          [ bench "makeCsPoppyBlocks2"  (whnf makeCsPoppyBlocks2 v)+          ]+ runBenchmarks :: IO () runBenchmarks = do-  benchmarks <- (concat <$>) $ sequence-    [ benchCsPoppyBuild-    , benchCsPoppyRank1-    , benchCsPoppySelect1-    , benchPoppy512Build-    , benchPoppy512Rank1-    , benchPoppy512Select1-    ]+  benchmarks <- (concat <$>) $ sequence $ []+    -- <> [benchCsPoppyBuild]+    -- <> [benchCsPoppyRank1]+    -- <> [benchCsPoppySelect1]+    -- <> [benchPoppy512Build]+    -- <> [benchPoppy512Rank1]+    -- <> [benchPoppy512Select1]+    <> [benchMakeCsPoppyBlocks1]+    <> [benchMakeCsPoppyBlocks2]   when (null benchmarks) $ putStrLn "Warning: No benchmarks found"   defaultMain benchmarks 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 04c09fd64febc5764a2fe1b9ff87b6861eab68c84395a2dc4cfbdca94a1d17de+-- hash: 552766a2425a826df7c278b72e30f84fe3e9d712bdb15844c18b482ee3b3d107  name:           hw-rankselect-version:        0.12.0.0+version:        0.12.0.1 synopsis:       Rank-select description:    Please see README.md category:       Data, Conduit

@@ -47,7 +47,6 @@ import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.RankSelect.CsPoppy.Internal-import HaskellWorks.Data.Take import HaskellWorks.Data.Vector.AsVector64 import Prelude                                         hiding (drop, length, pi, take) @@ -96,17 +95,17 @@ lastOrZero _ = 0 {-# INLINE lastOrZero #-} +-- TODO Try to get rid of indexOrZero call makeCsPoppy :: DVS.Vector Word64 -> CsPoppy makeCsPoppy v = CsPoppy   { csPoppyBits   = v   , csPoppyLayerM = layerM   , csPoppyLayerS = layerS   }-  where blocks  = DVS.constructN (((DVS.length v      + 8 - 1) `div` 8) + 1) genBlocks+  where blocks  = makeCsPoppyBlocks2 v         layerM  = DVS.constructN (((DVS.length blocks + 4 - 1) `div` 4) + 1) genLayer1         layerMPopCount = getCsiTotal (CsInterleaved (lastOrZero layerM))         layerS = genCsSamples layerMPopCount v-        genBlocks u = let i = length u in popCount1 (take 8 (drop (i * 8) v))         genLayer1 :: DVS.Vector Word64 -> Word64         genLayer1 u =           let i  = end u                          in

@@ -1,4 +1,6 @@ {-# OPTIONS_GHC-funbox-strict-fields #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE Rank2Types #-}  module HaskellWorks.Data.RankSelect.CsPoppy.Internal     ( CsInterleaved(..)@@ -12,13 +14,18 @@     , putCsiA     , putCsiB     , putCsiC+    , makeCsPoppyBlocks1+    , makeCsPoppyBlocks2     ) where  import Data.Word import Foreign.Ptr import Foreign.Storable import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount1 +import qualified Data.Vector.Storable as DVS+ newtype CsInterleaved = CsInterleaved { unCsInterleaved :: Word64 } deriving Eq  instance Storable CsInterleaved where@@ -67,3 +74,24 @@  instance Show CsInterleaved where   showsPrec _ i = shows (getCsiX i, getCsiA i, getCsiB i, getCsiC i)++makeCsPoppyBlocks1 :: DVS.Vector Word64 -> DVS.Vector Word64+makeCsPoppyBlocks1 v = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) genBlocks+  where genBlocks :: DVS.Vector Word64 -> Word64+        genBlocks u = let i = DVS.length u in popCount1 (DVS.take 8 (DVS.drop (i * 8) v))++makeCsPoppyBlocks2 :: DVS.Vector Word64 -> DVS.Vector Word64+makeCsPoppyBlocks2 v = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) genBlocks+  where e = DVS.length v+        genBlocks :: DVS.Vector Word64 -> Word64+        genBlocks u = let i = DVS.length u in if+          | (i + 1) * 8 <= e -> let j = i * 8 in+              popCount1 (DVS.unsafeIndex v (j + 0)) ++              popCount1 (DVS.unsafeIndex v (j + 1)) ++              popCount1 (DVS.unsafeIndex v (j + 2)) ++              popCount1 (DVS.unsafeIndex v (j + 3)) ++              popCount1 (DVS.unsafeIndex v (j + 4)) ++              popCount1 (DVS.unsafeIndex v (j + 5)) ++              popCount1 (DVS.unsafeIndex v (j + 6)) ++              popCount1 (DVS.unsafeIndex v (j + 7))+          | otherwise -> popCount1 (DVS.take 8 (DVS.drop (i * 8) v))

@@ -9,8 +9,9 @@ import Prelude                                       hiding (length) import Test.Hspec -import qualified Hedgehog.Gen   as G-import qualified Hedgehog.Range as R+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen         as G+import qualified Hedgehog.Range       as R  {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -40,3 +41,10 @@       getCsiA (putCsiA va (CsInterleaved 0)) === (va .&. 0x3ff)       getCsiB (putCsiB vb (CsInterleaved 0)) === (vb .&. 0x3ff)       getCsiC (putCsiC vc (CsInterleaved 0)) === (vc .&. 0x3ff)+  describe "makeCsPoppyBlocks2" $ do+    it "must behave like makeCsPoppyBlocks1" $ requireProperty $ do+      xs <- forAll $ G.list (R.linear 0 1000) (G.word64 R.constantBounded)+      v  <- forAll $ pure $ DVS.fromList xs+      a  <- forAll $ pure $ makeCsPoppyBlocks2 v+      e  <- forAll $ pure $ makeCsPoppyBlocks1 v+      a === e