hw-rankselect-base 0.2.0.2 → 0.3.0.0

raw patch · 12 files changed

+461/−201 lines, 12 filesdep +bits-extradep +hedgehogdep +hw-hedgehogPVP ok

version bump matches the API change (PVP)

Dependencies added: bits-extra, hedgehog, hw-hedgehog, hw-hspec-hedgehog

API changes (from Hackage documentation)

Files

• README.md +109/−1
• bench/Main.hs +25/−5
• hw-rankselect-base.cabal +105/−63
• src/HaskellWorks/Data/RankSelect/Base/Internal.hs +119/−0
• src/HaskellWorks/Data/RankSelect/Base/Rank.hs +6/−6
• src/HaskellWorks/Data/RankSelect/Base/Rank0.hs +12/−11
• src/HaskellWorks/Data/RankSelect/Base/Rank1.hs +0/−1
• src/HaskellWorks/Data/RankSelect/Base/Select.hs +3/−3
• src/HaskellWorks/Data/RankSelect/Base/Select0.hs +24/−23
• src/HaskellWorks/Data/RankSelect/Base/Select1.hs +28/−86
• test/HaskellWorks/Data/RankSelect/Base/InternalSpec.hs +28/−0
• test/HaskellWorks/Data/RankSelect/Base/Select1Spec.hs +2/−2

@@ -1,4 +1,112 @@ # hw-rankselect-base-[![0.0-branch](https://circleci.com/gh/haskell-works/hw-rankselect-base/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect-base/tree/0.0-branch)+[![CircleCI](https://circleci.com/gh/haskell-works/hw-rankselect-base.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect-base)  Rank and select operations.++This library will use support for some BMI2 CPU instructions on some x86 based+CPUs if compiled with the appropriate flags on `ghc-8.4.1` or later.++## Rank and select++This library provides the following functions on various types:++* `rank1`+* `rank0`+* `select1`+* `select0`++Type class instances are provided for the following primitive types:++* `Bool`+* `Word8`+* `Word16`+* `Word32`+* `Word64`++Moreover additional type class instances are provided for `[]`, `Vector`+from both `Data.Vector`, and `Data.Vector.Storable` of these primitive+types.++The collection-based type classes instances are not intended to be used+in high-performance code because they have poor performance for most+purposes and are provided purely as reference implementations.++Bit-vectors larger than 64-bits need indexing to achieve higher performance.+A indexed bit-vector implementation can found in the+[hw-rankselect](https://hackage.haskell.org/package/hw-rankselect) package.++## Notes++This library follows standard 1-based counting conventions typically found in+Computer Science literature where `select1 10 2 = 4` as illustrated here:++```text+  8 7 6 5  [4]3 2 1+  0 0 0 0   1 0 1 0+```++The standard convention for the `bmi2` implementation, comes at a small cost.++An internal function `select1Word64Bmi2Base0` demonstrates 0-based counting+that is slightly faster when implemented with the `bmi2` instruction set where+`select1 10 1 = 3` as illustrated here:++```text+  7 6 5 4  [3]2 1 0+  0 0 0 0   1 0 1 0+```++## Compilation++It is sufficient to build, test and benchmark the library as follows+for emulated behaviour:++```text+stack build+stack test+stack bench+```++To target the BMI2 instruction set, add the `bmi2` flag:++```text+stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2+stack test  --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2+stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2+```++## Benchmark results++The following benchmark shows the kinds of performance gain that can+be expected from enabling the BMI2 instruction set for CPU targets+that support them:++```text+benchmarking 64-bit/Once: Select1 Broadword+time                 14.75 ns   (14.63 ns .. 14.90 ns)+                     0.996 R²   (0.987 R² .. 0.999 R²)+mean                 15.35 ns   (14.92 ns .. 16.70 ns)+std dev              2.355 ns   (607.2 ps .. 4.849 ns)+variance introduced by outliers: 96% (severely inflated)++benchmarking 64-bit/Once: Select1 Bmi2+time                 6.026 ns   (5.933 ns .. 6.134 ns)+                     0.999 R²   (0.998 R² .. 0.999 R²)+mean                 6.024 ns   (5.966 ns .. 6.096 ns)+std dev              224.4 ps   (176.9 ps .. 318.6 ps)+variance introduced by outliers: 62% (severely inflated)++benchmarking 32-bit/Once: Select1 Broadword+time                 26.09 ns   (25.84 ns .. 26.40 ns)+                     0.999 R²   (0.998 R² .. 0.999 R²)+mean                 26.67 ns   (26.37 ns .. 27.01 ns)+std dev              1.017 ns   (848.4 ps .. 1.291 ns)+variance introduced by outliers: 61% (severely inflated)++benchmarking 32-bit/Once: Select1 Bmi2+time                 8.613 ns   (8.543 ns .. 8.687 ns)+                     0.999 R²   (0.999 R² .. 1.000 R²)+mean                 8.592 ns   (8.515 ns .. 8.671 ns)+std dev              248.3 ps   (216.2 ps .. 294.8 ps)+variance introduced by outliers: 48% (moderately inflated)+```

@@ -2,11 +2,14 @@  module Main where -import           Criterion.Main-import qualified Data.Vector.Storable                                   as DVS-import           Data.Word-import           HaskellWorks.Data.RankSelect.Base+import Criterion.Main+import Data.Bits.Pdep+import Data.Word+import HaskellWorks.Data.RankSelect.Base+import HaskellWorks.Data.RankSelect.Base.Internal +import qualified Data.Vector.Storable as DVS+ setupEnvVector :: Int -> IO (DVS.Vector Word64) setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) @@ -33,7 +36,24 @@     , bench "Select - Once" (whnf (select1  bv) 1)     , bench "Rank - Many"   (nf   (map (rank1 bv)) [0, 1000..10000000])     ]+  , env (return ()) $ \_ -> bgroup "64-bit"+    [ bench "Once: Rank1"               (whnf (rank1                  (0x5555555555555555 :: Word64)) 64)+    , bench "Once: Select1 Class"       (whnf (select1                (0x5555555555555555 :: Word64)) 64)+    , bench "Once: Select1 Function"    (whnf (select1Word64          (0x5555555555555555 :: Word64)) 64)+    , bench "Once: Select1 Broadword"   (whnf (select1Word64Broadword (0x5555555555555555 :: Word64)) 64)+    , bench "Once: Select1 Bmi2"        (whnf (select1Word64Bmi2      (0x5555555555555555 :: Word64)) 64)+    , bench "Once: Select1 Bmi2Base0"   (whnf (select1Word64Bmi2Base0 (0x5555555555555555 :: Word64)) 64)+    ]+  , env (return ()) $ \_ -> bgroup "32-bit"+    [ bench "Once: Rank1"               (whnf (rank1                  (0x55555555 :: Word32)) 32)+    , bench "Once: Select1 Class"       (whnf (select1                (0x55555555 :: Word32)) 32)+    , bench "Once: Select1 Function"    (whnf (select1Word32          (0x55555555 :: Word32)) 32)+    , bench "Once: Select1 Broadword"   (whnf (select1Word32Broadword (0x55555555 :: Word32)) 32)+    , bench "Once: Select1 Bmi2"        (whnf (select1Word32Bmi2      (0x55555555 :: Word32)) 32)+    ]   ]  main :: IO ()-main = defaultMain benchRankSelect+main = do+  putStrLn $ "Fast pdep enabled: " <> show fastPdepEnabled+  defaultMain benchRankSelect

@@ -1,70 +1,112 @@-name:                   hw-rankselect-base-version:                0.2.0.2-synopsis:               Rank-select base-description:            Please see README.md-homepage:               http://github.com/haskell-works/hw-rankselect-base#readme-license:                BSD3-license-file:           LICENSE-author:                 John Ky-maintainer:             newhoggy@gmail.com-copyright:              2016 John Ky-category:               Data-build-type:             Simple-extra-source-files:     README.md-cabal-version:          >= 1.22--library-  hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.RankSelect.Base-                      , HaskellWorks.Data.RankSelect.Base.Rank-                      , HaskellWorks.Data.RankSelect.Base.Rank0-                      , HaskellWorks.Data.RankSelect.Base.Rank1-                      , HaskellWorks.Data.RankSelect.Base.Select-                      , HaskellWorks.Data.RankSelect.Base.Select0-                      , HaskellWorks.Data.RankSelect.Base.Select1-  build-depends:        base                          >= 4          && < 5-                      , hw-bits                       >= 0.4.0.0-                      , hw-int                        >= 0.0.0.1-                      , hw-prim                       >= 0.4.0.0-                      , hw-string-parse               >= 0.0.0.2-                      , safe-                      , vector--  default-language:     Haskell2010-  ghc-options:          -Wall -O2 -msse4.2+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: e621f9ce4411c3740727c5167f0f6488c0a25514832ad5d6359e86474477c5ff -test-suite hw-rankselect-base-test-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-  main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.RankSelect.Base.Rank0Spec-                      , HaskellWorks.Data.RankSelect.Base.Rank1Spec-                      , HaskellWorks.Data.RankSelect.Base.Select0Spec-                      , HaskellWorks.Data.RankSelect.Base.Select1Spec+name:           hw-rankselect-base+version:        0.3.0.0+synopsis:       Rank-select base+description:    Please see README.md+category:       Data+homepage:       http://github.com/haskell-works/hw-rankselect-base#readme+bug-reports:    https://github.com/haskell-works/hw-rankselect-base/issues+author:         John Ky+maintainer:     newhoggy@gmail.com+copyright:      2016 John Ky+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -  build-depends:        base                          >= 4          && < 5-                      , hspec-                      , hw-bits                       >= 0.4.0.0-                      , hw-prim                       >= 0.4.0.0-                      , hw-rankselect-base-                      , QuickCheck-                      , vector-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:     Haskell2010+extra-source-files:+    README.md  source-repository head-  type:     git+  type: git   location: https://github.com/haskell-works/hw-rankselect-base +flag bmi2+  description: Enable bmi2 instruction set+  manual: False+  default: False++library+  hs-source-dirs:+      src+  ghc-options: -Wall -O2 -msse4.2+  build-depends:+      base >=4 && <5+    , bits-extra+    , hw-bits >=0.4.0.0+    , hw-int >=0.0.0.1+    , hw-prim >=0.4.0.0+    , hw-string-parse >=0.0.0.2+    , safe+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  exposed-modules:+      HaskellWorks.Data.RankSelect.Base+      HaskellWorks.Data.RankSelect.Base.Internal+      HaskellWorks.Data.RankSelect.Base.Rank+      HaskellWorks.Data.RankSelect.Base.Rank0+      HaskellWorks.Data.RankSelect.Base.Rank1+      HaskellWorks.Data.RankSelect.Base.Select+      HaskellWorks.Data.RankSelect.Base.Select0+      HaskellWorks.Data.RankSelect.Base.Select1+  other-modules:+      Paths_hw_rankselect_base+  default-language: Haskell2010++test-suite hw-rankselect-base-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base >=4 && <5+    , bits-extra+    , hedgehog+    , hspec+    , hw-bits >=0.4.0.0+    , hw-hedgehog+    , hw-hspec-hedgehog+    , hw-prim >=0.4.0.0+    , hw-rankselect-base+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  other-modules:+      HaskellWorks.Data.RankSelect.Base.InternalSpec+      HaskellWorks.Data.RankSelect.Base.Rank0Spec+      HaskellWorks.Data.RankSelect.Base.Rank1Spec+      HaskellWorks.Data.RankSelect.Base.Select0Spec+      HaskellWorks.Data.RankSelect.Base.Select1Spec+      Paths_hw_rankselect_base+  default-language: Haskell2010+ benchmark bench-    Type: exitcode-stdio-1.0-    HS-Source-Dirs: bench-    Main-Is: Main.hs-    GHC-Options: -O2 -Wall -msse4.2-    Default-Language: Haskell2010-    Build-Depends:      base                          >= 4          && < 5-                      , criterion-                      , hw-bits                       >= 0.4.0.0-                      , hw-prim                       >= 0.4.0.0-                      , hw-rankselect-base-                      , vector+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      bench+  ghc-options: -Wall -O2 -msse4.2+  build-depends:+      base >=4 && <5+    , bits-extra+    , criterion+    , hw-bits >=0.4.0.0+    , hw-prim >=0.4.0.0+    , hw-rankselect-base+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  other-modules:+      Paths_hw_rankselect_base+  default-language: Haskell2010

@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}++module HaskellWorks.Data.RankSelect.Base.Internal+    ( select1Word64Broadword+    , select1Word64Bmi2+    , select1Word64Bmi2Base0+    , select1Word64+    , select1Word32Broadword+    , select1Word32Bmi2+    , select1Word32+    ) where++import Data.Bits                      (countTrailingZeros, shiftR)+import Data.Bits.Pdep+import Data.Int+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Int.Narrow++select1Word64Bmi2Base0 :: Word64 -> Word64 -> Word64+select1Word64Bmi2Base0 w r = fromIntegral (countTrailingZeros (pdep (1 .<. r) w))+{-# INLINE select1Word64Bmi2Base0 #-}++select1Word64Bmi2 :: Word64 -> Word64 -> Word64+select1Word64Bmi2 w r =+  let zeros = countTrailingZeros (pdep (1 .<. (r - 1)) w) :: Int+      mask  = fromIntegral ((fromIntegral (zeros .<. 57) :: Int64) `shiftR` 63) :: Word64+  in (fromIntegral zeros .|. mask) + 1+{-# INLINE select1Word64Bmi2 #-}++select1Word32Bmi2 :: Word32 -> Word64 -> Word64+select1Word32Bmi2 w r =+  let zeros = countTrailingZeros (pdep (1 .<. (r - 1)) w) :: Int+      mask  = fromIntegral ((fromIntegral (zeros .<. 58) :: Int64) `shiftR` 63) :: Word64+  in (fromIntegral zeros .|. mask) + 1+{-# INLINE select1Word32Bmi2 #-}++select1Word64Broadword :: Word64 -> Word64 -> Word64+select1Word64Broadword _ 0 = 0+select1Word64Broadword v rn =+  -- Do a normal parallel bit count for a 64-bit integer,+  -- but store all intermediate steps.+  let a = (v .&. 0x5555555555555555) + ((v .>.  1) .&. 0x5555555555555555)    in+  let b = (a .&. 0x3333333333333333) + ((a .>.  2) .&. 0x3333333333333333)    in+  let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f0f0f0f0f)    in+  let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>.  8) .&. 0x00ff00ff00ff00ff)    in+  let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff)    in+  let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff)    in+  -- Now do branchless select!+  let r0 = f + 1 - narrow64 rn                                                in+  let s0 = 64 :: Word64                                                       in+  let t0 = (d .>. 32) + (d .>. 48)                                            in+  let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+  let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+  let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+  let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+  let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+  let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+  let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+  let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+  let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+  let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+  let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+  let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+  let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+  let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+  let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+  let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+  fromIntegral s6+{-# INLINE select1Word64Broadword #-}++select1Word32Broadword :: Word32 -> Word64 -> Word64+select1Word32Broadword _ 0 = 0+select1Word32Broadword v rn =+  -- Do a normal parallel bit count for a 64-bit integer,+  -- but store all intermediate steps.+  let a = (v .&. 0x55555555) + ((v .>.  1) .&. 0x55555555)    in+  let b = (a .&. 0x33333333) + ((a .>.  2) .&. 0x33333333)    in+  let c = (b .&. 0x0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f)    in+  let d = (c .&. 0x00ff00ff) + ((c .>.  8) .&. 0x00ff00ff)    in+  let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff)    in+  -- Now do branchless select!+  let r0 = e + 1 - narrow32 rn                                                in+  let s0 = 64 :: Word32                                                       in+  let t0 = (d .>. 32) + (d .>. 48)                                            in+  let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+  let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+  let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+  let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+  let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+  let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+  let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+  let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+  let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+  let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+  let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+  let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+  let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+  let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+  let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+  let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+  fromIntegral s6+{-# INLINE select1Word32Broadword #-}++select1Word64 :: Word64 -> Word64 -> Word64+#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)+select1Word64 = select1Word64Bmi2+#else+select1Word64 = select1Word64Broadword+#endif+{-# INLINE select1Word64 #-}++select1Word32 :: Word32 -> Word64 -> Word64+#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)+select1Word32 = select1Word32Bmi2+#else+select1Word32 = select1Word32Broadword+#endif+{-# INLINE select1Word32 #-}

@@ -2,13 +2,13 @@ {-# LANGUAGE MultiParamTypeClasses #-}  module HaskellWorks.Data.RankSelect.Base.Rank-    ( -- * Rank & Select-      Rank(..)-    ) where+  ( -- * Rank & Select+    Rank(..)+  ) where -import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1  class Eq a => Rank v a where   rank :: a -> v -> Count -> Count

@@ -6,17 +6,18 @@     ( Rank0(..)     ) where -import qualified Data.Vector                                as DV-import qualified Data.Vector.Storable                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.ElemFixedBitSize-import           HaskellWorks.Data.Bits.PopCount.PopCount0-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank1    as X-import           Prelude                                    as P+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.ElemFixedBitSize+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank1   as X+import Prelude                                   as P +import qualified Data.Vector          as DV+import qualified Data.Vector.Storable as DVS+ {-# ANN module ("HLint: Ignore Reduce duplication"  :: String) #-}  class Rank0 v where@@ -42,7 +43,7 @@  instance Rank0 [Bool] where   rank0 = go 0-    where go r _ 0 = r+    where go r _ 0          = r           go r (False:bs) p = go (r + 1) bs (p - 1)           go r (True:bs) p  = go  r      bs (p - 1)           go _ [] _         = error "Out of range"

@@ -13,7 +13,6 @@ import HaskellWorks.Data.Bits.ElemFixedBitSize import HaskellWorks.Data.Bits.PopCount.PopCount1 import HaskellWorks.Data.Positioning-import Prelude                                   as P  import qualified Data.Vector          as DV import qualified Data.Vector.Storable as DVS

@@ -6,9 +6,9 @@       Select(..)     ) where -import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Select0-import           HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Data.RankSelect.Base.Select1  class Eq a => Select v a where   select :: a -> v -> Count -> Count

@@ -6,17 +6,18 @@     ( Select0(..)     ) where -import qualified Data.Vector                                as DV-import qualified Data.Vector.Storable                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.ElemFixedBitSize-import           HaskellWorks.Data.Bits.PopCount.PopCount0-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Select1+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.ElemFixedBitSize+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Select1 +import qualified Data.Vector          as DV+import qualified Data.Vector.Storable as DVS+ {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}  class Select0 v where@@ -43,7 +44,7 @@  instance Select0 [Bool] where   select0 = go 0-    where go r _ 0 = r+    where go r _ 0          = r           go r (False:bs) c = go (r + 1) bs (c - 1)           go r (True:bs)  c = go (r + 1) bs  c           go _ []         _ = error "Out of range"@@ -56,7 +57,7 @@           go u d acc = let w = head u in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINABLE select0 #-}  instance Select0 [Word16] where@@ -66,7 +67,7 @@           go u d acc = let w = head u in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINABLE select0 #-}  instance Select0 [Word32] where@@ -76,7 +77,7 @@           go u d acc = let w = head u in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINABLE select0 #-}  instance Select0 [Word64] where@@ -86,7 +87,7 @@           go u d acc = let w = head u in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINABLE select0 #-}  instance Select0 (DV.Vector Word8) where@@ -95,7 +96,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DV.Vector Word16) where@@ -104,7 +105,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DV.Vector Word32) where@@ -113,7 +114,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DV.Vector Word64) where@@ -122,7 +123,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DVS.Vector Word8) where@@ -131,7 +132,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DVS.Vector Word16) where@@ -140,7 +141,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DVS.Vector Word32) where@@ -149,7 +150,7 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}  instance Select0 (DVS.Vector Word64) where@@ -158,5 +159,5 @@           go n d acc = let w = (v !!! n) in             case popCount0 w of               pc | d <= pc  -> select0 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINABLE select0 #-}

@@ -6,18 +6,20 @@     ( Select1(..)     ) where -import qualified Data.Vector                               as DV-import qualified Data.Vector.Storable                      as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.ElemFixedBitSize-import           HaskellWorks.Data.Bits.PopCount.PopCount1-import           HaskellWorks.Data.Int.Narrow-import           HaskellWorks.Data.Positioning-import           Prelude                                   as P+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.ElemFixedBitSize+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Int.Narrow+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Internal+import Prelude +import qualified Data.Vector          as DV+import qualified Data.Vector.Storable as DVS+ class Select1 v where   select1 :: v -> Count -> Count @@ -62,77 +64,17 @@     fromIntegral s6   {-# INLINE select1 #-} --- TODO: Remove redundant code to optimise instance Select1 Word32 where-  select1 _ 0 = 0-  select1 v rn =-    -- Do a normal parallel bit count for a 64-bit integer,-    -- but store all intermediate steps.-    let a = (v .&. 0x55555555) + ((v .>.  1) .&. 0x55555555)    in-    let b = (a .&. 0x33333333) + ((a .>.  2) .&. 0x33333333)    in-    let c = (b .&. 0x0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f)    in-    let d = (c .&. 0x00ff00ff) + ((c .>.  8) .&. 0x00ff00ff)    in-    let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff)    in-    -- Now do branchless select!-    let r0 = e + 1 - narrow32 rn                                                in-    let s0 = 64 :: Word32                                                       in-    let t0 = (d .>. 32) + (d .>. 48)                                            in-    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in-    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in-    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in-    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in-    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in-    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in-    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in-    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in-    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in-    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in-    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in-    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in-    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in-    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in-    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in-    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in-    fromIntegral s6+  select1 = select1Word32   {-# INLINE select1 #-}  instance Select1 Word64 where-  select1 _ 0 = 0-  select1 v rn =-    -- Do a normal parallel bit count for a 64-bit integer,-    -- but store all intermediate steps.-    let a = (v .&. 0x5555555555555555) + ((v .>.  1) .&. 0x5555555555555555)    in-    let b = (a .&. 0x3333333333333333) + ((a .>.  2) .&. 0x3333333333333333)    in-    let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f0f0f0f0f)    in-    let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>.  8) .&. 0x00ff00ff00ff00ff)    in-    let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff)    in-    let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff)    in-    -- Now do branchless select!-    let r0 = f + 1 - narrow64 rn                                                in-    let s0 = 64 :: Word64                                                       in-    let t0 = (d .>. 32) + (d .>. 48)                                            in-    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in-    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in-    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in-    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in-    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in-    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in-    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in-    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in-    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in-    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in-    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in-    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in-    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in-    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in-    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in-    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in-    fromIntegral s6+  select1 = select1Word64   {-# INLINE select1 #-}  instance Select1 [Bool] where   select1 = go 0-    where go r _ 0 = r+    where go r _ 0          = r           go r (True :bs) c = go (r + 1) bs (c - 1)           go r (False:bs) c = go (r + 1) bs  c           go _ []         _ = error "Out of range"@@ -145,7 +87,7 @@           go u d acc = let w = head u in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINE select1 #-}  instance Select1 [Word16] where@@ -155,7 +97,7 @@           go u d acc = let w = head u in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINE select1 #-}  instance Select1 [Word32] where@@ -165,7 +107,7 @@           go u d acc = let w = head u in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINE select1 #-}  instance Select1 [Word64] where@@ -175,7 +117,7 @@           go u d acc = let w = head u in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+              pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)   {-# INLINE select1 #-}  instance Select1 (DVS.Vector Word8) where@@ -184,7 +126,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DVS.Vector Word16) where@@ -193,7 +135,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DVS.Vector Word32) where@@ -202,7 +144,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DVS.Vector Word64) where@@ -211,7 +153,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DV.Vector Word8) where@@ -220,7 +162,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DV.Vector Word16) where@@ -229,7 +171,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DV.Vector Word32) where@@ -238,7 +180,7 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}  instance Select1 (DV.Vector Word64) where@@ -247,5 +189,5 @@           go n d acc = let w = (v !!! n) in             case popCount1 w of               pc | d <= pc  -> select1 w d + acc-              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+              pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)   {-# INLINE select1 #-}

@@ -0,0 +1,28 @@+module HaskellWorks.Data.RankSelect.Base.InternalSpec+  ( spec+  ) where++import Control.Monad                              (mfilter)+import Data.Bits                                  (popCount)+import HaskellWorks.Data.RankSelect.Base.Internal+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++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) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.RankSelect.Base.InternalSpec" $ do+  describe "Bmi2 and broadword implementations match" $ do+    it "64-bit" $ require $ property $ do+      s <- forAll $ mfilter (/= 0) (G.word64 R.constantBounded)+      r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s)))+      select1Word64Broadword s r === select1Word64Bmi2 s r+    it "32-bit" $ require $ property $ do+      s <- forAll $ mfilter (/= 0) (G.word32 R.constantBounded)+      r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s)))+      select1Word32Broadword s r === select1Word32Bmi2 s r

@@ -10,8 +10,8 @@  import           Data.Maybe import           Data.Typeable-import qualified Data.Vector                                                as DV-import qualified Data.Vector.Storable                                       as DVS+import qualified Data.Vector                               as DV+import qualified Data.Vector.Storable                      as DVS import           Data.Word import           HaskellWorks.Data.Bits.BitRead import           HaskellWorks.Data.Bits.BitWise