hw-rankselect 0.10.0.3 → 0.11.0.0

raw patch · 14 files changed

+569/−686 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +111/−2
• app/Main.hs +11/−39
• bench/Main.hs +11/−48
• hw-rankselect.cabal +132/−93
• src/HaskellWorks/Data/RankSelect/Poppy512S.hs +0/−163
• test/HaskellWorks/Data/RankSelect/BasicGen.hs +76/−58
• test/HaskellWorks/Data/RankSelect/CsPoppy/InternalSpec.hs +5/−5
• test/HaskellWorks/Data/RankSelect/CsPoppySpec.hs +14/−14
• test/HaskellWorks/Data/RankSelect/Gen.hs +15/−0
• test/HaskellWorks/Data/RankSelect/InternalSpec.hs +27/−23
• test/HaskellWorks/Data/RankSelect/Poppy512SSpec.hs +0/−94
• test/HaskellWorks/Data/RankSelect/Poppy512Spec.hs +98/−105
• test/HaskellWorks/Data/RankSelect/SimpleSpec.hs +59/−42
• test/HaskellWorks/Data/RankSelect/SpecCommon.hs +10/−0

@@ -1,4 +1,113 @@ # hw-rankselect-[![0.0-branch](https://circleci.com/gh/haskell-works/hw-rankselect/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect/tree/0.0-branch)+[![CircleCI](https://circleci.com/gh/haskell-works/hw-rankselect.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect) -Rank and select operations.+Efficient `rank` and `select` operations on large bit-vectors.++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 indexed bit-vectors:++* `rank1`+* `rank0`+* `select1`+* `select0`++The supported indexed bit-vector types are:++* `Poppy512`+* `CsPoppy`++## Constructing and using an indexed bit-vector in the repl++The example below constructs an indexed bit-vector from a string and runs+rank and select query operations on it.  The bits in a string are in+little-endian and can be of arbitrary length.  The resulting bit-vector+will be padded with 0-bits until the next 64-bit boundary.++```text+$ stack repl  --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2+λ> import HaskellWorks.Data.Bits.BitRead+λ> let bs = fromJust $ bitRead "10010010" :: CsPoppy+bs :: CsPoppy+λ> select1 bs 1+1+λ> select1 bs 2+4+λ> select1 bs 3+7+λ> rank1 bs 7+3+λ> rank1 bs 4+2+λ> rank1 bs 1+1+```++A valid bit string contains zero or more characters.  Characters other than `1` and `0` are+permitted, but are ignored.  For example spaces can be used to group bits for clarity.++```text+λ> let bs = fromJust $ bitRead "" :: CsPoppy+bs :: CsPoppy+λ> let bs = fromJust $ bitRead "10010010 10010010" :: CsPoppy+bs :: CsPoppy+```++Whilst the use of a bit string is convenient for the repl, for performance reasons, it+is more typical to construct an indexed bit-vector from a 64-bit word vector:++```text+> import qualified Data.Vector.Storable as DVS+λ> let bs = makeCsPoppy (DVS.fromList [23, 73, 55])+bs :: CsPoppy+```++## Compilation++It is sufficient to build, test and benchmark the library as follows+for basic performance.  The library will be compiled to use broadword+implementation of rank & select, which has reasonable performance.++```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 --flag hw-rankselect:bmi2+stack test  --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2+stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect: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 data/48-mb-bitvector/CsPoppy Select1+time                 3.636 μs   (3.613 μs .. 3.669 μs)+                     1.000 R²   (0.999 R² .. 1.000 R²)+mean                 3.618 μs   (3.607 μs .. 3.636 μs)+std dev              46.03 ns   (30.79 ns .. 78.23 ns)+```++```text+benchmarking data/48-mb-bitvector/CsPoppy Select1+time                 1.969 μs   (1.959 μs .. 1.982 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 1.973 μs   (1.963 μs .. 1.986 μs)+std dev              38.41 ns   (26.87 ns .. 59.08 ns)+variance introduced by outliers: 21% (moderately inflated)```+```++## References++* [Space-Efficient, High-Performance Rank & Select Structures on Uncompressed Bit Sequences](http://www.cs.cmu.edu/~./dga/papers/zhou-sea2013.pdf)

@@ -1,11 +1,11 @@-{-# LANGUAGE BangPatterns         #-}-{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Main where  import Control.Monad import Data.List-import Data.Monoid ((<>))+import Data.Monoid                               ((<>)) import Foreign import HaskellWorks.Data.Bits.PopCount.PopCount1 import HaskellWorks.Data.FromForeignRegion@@ -14,10 +14,9 @@ import System.Environment import System.IO.MMap -import qualified Data.Vector.Storable                   as DVS-import qualified HaskellWorks.Data.RankSelect.CsPoppy   as CS-import qualified HaskellWorks.Data.RankSelect.Poppy512  as P512-import qualified HaskellWorks.Data.RankSelect.Poppy512S as P512S+import qualified Data.Vector.Storable                  as DVS+import qualified HaskellWorks.Data.RankSelect.CsPoppy  as CS+import qualified HaskellWorks.Data.RankSelect.Poppy512 as P512  {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -31,9 +30,6 @@ loadPoppy512 :: FilePath -> IO P512.Poppy512 loadPoppy512 filename = P512.makePoppy512 <$> loadVector64 filename -loadPoppy512S :: FilePath -> IO P512S.Poppy512S-loadPoppy512S filename = P512S.makePoppy512S <$> loadVector64 filename- runCsPoppyBuild :: IO () runCsPoppyBuild = do   entries <- listDirectory "data"@@ -53,16 +49,6 @@     -- let !_ = select1 msbs 1     return () -runPoppy512SBuild :: IO ()-runPoppy512SBuild = do-  entries <- listDirectory "data"-  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries-  forM_ files $ \file -> do-    putStrLn $ "Loading cspoppy for " <> file-    P512S.Poppy512S !_ !_ !_ <- loadPoppy512S file-    -- let !_ = select1 msbs 1-    return ()- runPoppy512SelectAll :: IO () runPoppy512SelectAll = do   entries <- listDirectory "data"@@ -75,18 +61,6 @@       return ()     return () -runPoppy512SSelectAll :: IO ()-runPoppy512SSelectAll = do-  entries <- listDirectory "data"-  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries-  forM_ files $ \file -> do-    putStrLn $ "Loading cspoppy for " <> file-    v <- loadPoppy512S file-    forM_ [1..popCount1 v] $ \i -> do-      let !_ = select1 v i-      return ()-    return ()- runCsPoppySelectAll :: IO () runCsPoppySelectAll = do   entries <- listDirectory "data"@@ -103,10 +77,8 @@ main = do   args <- getArgs   case args of-    ["cspoppy-load"]          -> runCsPoppyBuild-    ["cspoppy-select-all"]    -> runCsPoppySelectAll-    ["poppy512-load"]         -> runPoppy512Build-    ["poppy512-select-all"]   -> runPoppy512SelectAll-    ["poppy512s-load"]        -> runPoppy512SBuild-    ["poppy512s-select-all"]  -> runPoppy512SSelectAll-    _                         -> putStrLn "Invalid arguments"+    ["cspoppy-load"]        -> runCsPoppyBuild+    ["cspoppy-select-all"]  -> runCsPoppySelectAll+    ["poppy512-load"]       -> runPoppy512Build+    ["poppy512-select-all"] -> runPoppy512SelectAll+    _                       -> putStrLn "Invalid arguments"

@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns         #-}-{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Main where @@ -15,10 +15,9 @@ import System.Environment import System.IO.MMap -import qualified Data.Vector.Storable                   as DVS-import qualified HaskellWorks.Data.RankSelect.CsPoppy   as CS-import qualified HaskellWorks.Data.RankSelect.Poppy512  as P512-import qualified HaskellWorks.Data.RankSelect.Poppy512S as P512S+import qualified Data.Vector.Storable                  as DVS+import qualified HaskellWorks.Data.RankSelect.CsPoppy  as CS+import qualified HaskellWorks.Data.RankSelect.Poppy512 as P512  {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -35,9 +34,6 @@ loadPoppy512 :: FilePath -> IO P512.Poppy512 loadPoppy512 filename = P512.makePoppy512 <$> loadVector64 filename -loadPoppy512S :: FilePath -> IO P512S.Poppy512S-loadPoppy512S filename = P512S.makePoppy512S <$> loadVector64 filename- benchCsPoppyBuild :: IO [Benchmark] benchCsPoppyBuild = do   entries <- listDirectory "data"@@ -65,7 +61,7 @@           [ bench "CsPoppy Select1"  (whnf (go rsbs 1 (popCount1 rsbs) ((popCount1 rsbs `div` 100) + 1)) 0)           ]         go rsbs a z step acc | a <= z  = go rsbs (a + step) z step (select1 rsbs a + acc)-        go _    _ _ _    acc           = acc+        go _    _ _ _    acc = acc         {-# INLINE go #-}  benchPoppy512Build :: IO [Benchmark]@@ -95,37 +91,7 @@           [ bench "Poppy512 Select1"  (whnf (go rsbs 1 (popCount1 rsbs) ((popCount1 rsbs `div` 100) + 1)) 0)           ]         go rsbs a z step acc | a <= z  = go rsbs (a + step) z step (select1 rsbs a + acc)-        go _    _ _ _    acc           = acc-        {-# INLINE go #-}--benchPoppy512SBuild :: IO [Benchmark]-benchPoppy512SBuild = do-  entries <- listDirectory "data"-  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries-  return (mkBenchmark <$> files)-  where mkBenchmark filename = env (loadVector64 filename) $ \bitString -> bgroup filename-          [ bench "Poppy512S Build"  (whnf P512S.makePoppy512S bitString)-          ]--benchPoppy512SRank1 :: IO [Benchmark]-benchPoppy512SRank1 = do-  entries <- listDirectory "data"-  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries-  return (mkBenchmark <$> files)-  where mkBenchmark filename = env (loadPoppy512S filename) $ \csPoppy -> bgroup filename-          [ bench "Poppy512S Rank1"  (whnf (CS.rank1 csPoppy) 100)-          ]--benchPoppy512SSelect1 :: IO [Benchmark]-benchPoppy512SSelect1 = do-  entries <- listDirectory "data"-  let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries-  return (mkBenchmark <$> files)-  where mkBenchmark filename = env (loadPoppy512S filename) $ \rsbs -> bgroup filename-          [ bench "Poppy512S Select1"  (whnf (go rsbs 1 (popCount1 rsbs) ((popCount1 rsbs `div` 100) + 1)) 0)-          ]-        go rsbs a z step acc | a <= z  = go rsbs (a + step) z step (select1 rsbs a + acc)-        go _    _ _ _    acc           = acc+        go _    _ _ _    acc = acc         {-# INLINE go #-}  runCsPoppyBuild :: IO ()@@ -133,7 +99,7 @@   entries <- listDirectory "data"   let files = ("data/" ++) <$> (".ib" `isSuffixOf`) `filter` entries   forM_ files $ \file -> do-    msbs <- loadPoppy512S file+    msbs <- loadCsPoppy file     let !_ = select1 msbs 1     return () @@ -145,9 +111,6 @@   , benchPoppy512Build   , benchPoppy512Rank1   , benchPoppy512Select1-  , benchPoppy512SBuild-  , benchPoppy512SRank1-  , benchPoppy512SSelect1   ]  @@ -155,6 +118,6 @@ main = do   args <- getArgs   case args of-    []                -> runBenchmarks-    ["load-cspoppy"]  -> runCsPoppyBuild-    _                 -> putStrLn "Invalid arguments"+    []               -> runBenchmarks+    ["load-cspoppy"] -> runCsPoppyBuild+    _                -> putStrLn "Invalid arguments"

@@ -1,102 +1,141 @@-name:                   hw-rankselect-version:                0.10.0.3-synopsis:               Rank-select-description:            Please see README.md-homepage:               http://github.com/haskell-works/hw-rankselect#readme-license:                BSD3-license-file:           LICENSE-author:                 John Ky-maintainer:             newhoggy@gmail.com-copyright:              2016 John Ky-category:               Data, Conduit-build-type:             Simple-extra-source-files:     README.md-                      , data/README.md-cabal-version:          >= 1.22+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: c8bfa99184048b3d2aed74f11f5df77b0cf12e8f60f810acc8cc9e5836ff4ee9 -library-  hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.RankSelect.CsPoppy-                      , HaskellWorks.Data.RankSelect.CsPoppy.Internal-                      , HaskellWorks.Data.RankSelect.Poppy512-                      , HaskellWorks.Data.RankSelect.Poppy512S-  build-depends:        base                          >= 4          && < 5-                      , deepseq-                      , hw-balancedparens             >= 0.1.0.0-                      , hw-bits                       >= 0.6.0.0-                      , hw-prim                       >= 0.4.0.3-                      , hw-rankselect-base            >= 0.2.0.0-                      , vector+name:           hw-rankselect+version:        0.11.0.0+synopsis:       Rank-select+description:    Please see README.md+category:       Data, Conduit+homepage:       http://github.com/haskell-works/hw-rankselect#readme+bug-reports:    https://github.com/haskell-works/hw-rankselect/issues+author:         John Ky+maintainer:     newhoggy@gmail.com+copyright:      2016 John Ky+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -  default-language:     Haskell2010-  ghc-options:          -Wall -O2 -msse4.2+extra-source-files:+    data/README.md+    README.md +source-repository head+  type: git+  location: https://github.com/haskell-works/hw-rankselect++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+    , deepseq+    , hw-balancedparens >=0.1.0.0+    , hw-bits >=0.6.0.0+    , hw-prim >=0.4.0.3+    , hw-rankselect-base >=0.2.0.0+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  exposed-modules:+      HaskellWorks.Data.RankSelect.CsPoppy+      HaskellWorks.Data.RankSelect.CsPoppy.Internal+      HaskellWorks.Data.RankSelect.Poppy512+  other-modules:+      Paths_hw_rankselect+  default-language: Haskell2010+ executable hw-rankselect-exe-  hs-source-dirs:       app-  main-is:              Main.hs-  default-language:     Haskell2010-  build-depends:        base >= 4.7 && < 5-                      -- , bytestring-                      -- , conduit-                      , directory-                      , hw-bits                       >= 0.4.0.0-                      , hw-prim                       >= 0.4.0.0-                      , hw-rankselect-                      , hw-rankselect-base            >= 0.2.0.0-                      , mmap-                      -- , resourcet-                      , vector-  ghc-options:       -threaded -rtsopts -O2 -msse4.2-  default-extensions: OverloadedStrings, TupleSections-  if os(darwin)+  main-is: Main.hs+  hs-source-dirs:+      app+  default-extensions: OverloadedStrings TupleSections+  ghc-options: -threaded -rtsopts -O2 -msse4.2+  build-depends:+      base >=4.7 && <5+    , directory+    , hw-bits >=0.4.0.0+    , hw-prim >=0.4.0.0+    , hw-rankselect+    , hw-rankselect-base >=0.2.0.0+    , mmap+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  if os(osx)     cpp-options: -D__attribute__(A)= -D_Nullable= -D_Nonnull=+  other-modules:+      Paths_hw_rankselect+  default-language: Haskell2010  test-suite hw-rankselect-test-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-  main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.RankSelect.BasicGen-                      , HaskellWorks.Data.RankSelect.CsPoppySpec-                      , HaskellWorks.Data.RankSelect.CsPoppy.InternalSpec-                      , HaskellWorks.Data.RankSelect.Poppy512Spec-                      , HaskellWorks.Data.RankSelect.Poppy512SSpec-                      , HaskellWorks.Data.RankSelect.InternalSpec-                      , HaskellWorks.Data.RankSelect.SimpleSpec-  build-depends:        base                          >= 4          && < 5-                      , directory-                      , hedgehog-                      , hspec-                      , hw-bits                       >= 0.4.0.0-                      , hw-hedgehog                   >= 0.1.0.1-                      , hw-hspec-hedgehog-                      , hw-prim                       >= 0.4.0.0-                      , hw-rankselect-                      , hw-rankselect-base            >= 0.2.0.0-                      , mmap-                      , QuickCheck-                      , vector-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:     Haskell2010+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base >=4 && <5+    , directory+    , hedgehog+    , hspec+    , hw-bits >=0.4.0.0+    , hw-hedgehog >=0.1.0.1+    , hw-hspec-hedgehog+    , hw-prim >=0.4.0.0+    , hw-rankselect+    , hw-rankselect-base >=0.2.0.0+    , mmap+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  other-modules:+      HaskellWorks.Data.RankSelect.BasicGen+      HaskellWorks.Data.RankSelect.CsPoppy.InternalSpec+      HaskellWorks.Data.RankSelect.CsPoppySpec+      HaskellWorks.Data.RankSelect.Gen+      HaskellWorks.Data.RankSelect.InternalSpec+      HaskellWorks.Data.RankSelect.Poppy512Spec+      HaskellWorks.Data.RankSelect.SimpleSpec+      HaskellWorks.Data.RankSelect.SpecCommon+      Paths_hw_rankselect+  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-                      , bytestring-                      , conduit-                      , criterion-                      , directory-                      , hw-bits                       >= 0.4.0.0-                      , hw-prim                       >= 0.4.0.0-                      , hw-rankselect-                      , hw-rankselect-base            >= 0.2.0.0-                      , mmap-                      , resourcet-                      , vector--source-repository head-  type:     git-  location: https://github.com/haskell-works/hw-rankselect+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      bench+  ghc-options: -O2 -Wall -msse4.2+  build-depends:+      base >=4 && <5+    , bytestring+    , conduit+    , criterion+    , directory+    , hw-bits >=0.4.0.0+    , hw-prim >=0.4.0.0+    , hw-rankselect+    , hw-rankselect-base >=0.2.0.0+    , mmap+    , resourcet+    , vector+  if (flag(bmi2)) && (impl(ghc >=8.4.1))+    ghc-options: -mbmi2 -msse4.2+    cpp-options: -DBMI2_ENABLED+  other-modules:+      Paths_hw_rankselect+  default-language: Haskell2010

@@ -1,163 +0,0 @@-{-# OPTIONS_GHC-funbox-strict-fields #-}--{-# LANGUAGE BangPatterns   #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}--module HaskellWorks.Data.RankSelect.Poppy512S-    ( Poppy512S(..)-    , Rank1(..)-    , makePoppy512S-    , sampleRange-    ) where--import Control.DeepSeq-import Data.Word-import GHC.Generics-import HaskellWorks.Data.AtIndex-import HaskellWorks.Data.BalancedParens.BalancedParens-import HaskellWorks.Data.BalancedParens.CloseAt-import HaskellWorks.Data.BalancedParens.Enclose-import HaskellWorks.Data.BalancedParens.FindClose-import HaskellWorks.Data.BalancedParens.FindCloseN-import HaskellWorks.Data.BalancedParens.FindOpen-import HaskellWorks.Data.BalancedParens.FindOpenN-import HaskellWorks.Data.BalancedParens.NewCloseAt-import HaskellWorks.Data.BalancedParens.OpenAt-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.Search-import HaskellWorks.Data.Vector.AsVector64-import Prelude                                         hiding (length)--import qualified Data.Vector.Storable as DVS--data Poppy512S = Poppy512S-  { poppy512SBits   :: !(DVS.Vector Word64)-  , poppy512Index   :: !(DVS.Vector Word64)-  , poppy512Samples :: !(DVS.Vector Word64) -- Sampling position of each 8192 1-bit-  } deriving (Eq, Show, NFData, Generic)--instance AsVector64 Poppy512S where-  asVector64 = asVector64 . poppy512SBits-  {-# INLINE asVector64 #-}--instance PopCount1 Poppy512S where-  popCount1 = popCount1 . poppy512SBits-  {-# INLINE popCount1 #-}--popCount1Range :: Int -> Int -> DVS.Vector Count -> Count-popCount1Range start len = popCount1 . DVS.take len . DVS.drop start--makePoppy512S :: DVS.Vector Word64 -> Poppy512S-makePoppy512S v = Poppy512S-  { poppy512SBits     = v-  , poppy512Index     = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) gen512Index-  , poppy512Samples   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)-  }-  where gen512Index !u = let !indexN = DVS.length u - 1 in-          if indexN == -1-            then 0-            else let !result = popCount1Range (indexN * 8) 8 v + DVS.last u in result-        genS :: (Count, Position) -> Maybe (Word64, (Count, Position))-        genS (!pca, !n) = if n < end v-          then  let !w = v !!! n in-                let !pcz = pca + popCount1 w in-                if (8192 - 1 + pca) `div` 8192 /= (8192 - 1 + pcz) `div` 8192-                  then  let !newWord = fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192))))-                            !newCount = pcz-                            !newPosition = n + 1-                            !newState = (newCount, newPosition)-                            !newResult = (newWord, newState) in-                        Just newResult-                  else  let !newCount = n + 1-                            !newState = (pcz, newCount) in-                        genS newState-          else Nothing--instance BitLength Poppy512S where-  bitLength v = length (poppy512SBits v) * bitLength (poppy512SBits v !!! 0)-  {-# INLINE bitLength #-}--instance TestBit Poppy512S where-  (.?.) = (.?.) . poppy512SBits-  {-# INLINE (.?.) #-}--instance BitRead Poppy512S where-  bitRead = fmap makePoppy512S . bitRead--instance Rank1 Poppy512S where-  rank1 (Poppy512S v i _) p =-    (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)--instance Rank0 Poppy512S where-  rank0 (Poppy512S v i _) p =-    p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)--sampleRange :: Poppy512S -> Count -> (Word64, Word64)-sampleRange (Poppy512S _ index samples) p =-  let j = (fromIntegral p - 1) `div` 8192 in-  if 0 <= j && j < DVS.length samples-    then  let pa = samples DVS.! j                in-          if j + 1 < DVS.length samples-            then  let pz = samples DVS.! (j + 1)          in-                  (pa, pz)-            else (pa, fromIntegral (DVS.length index - 1))-    else (1, fromIntegral (DVS.length index - 1))--instance Select1 Poppy512S where-  select1 iv@(Poppy512S v i _) p = if DVS.length v /= 0-      then toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)-      else 0-    where q = binarySearch (fromIntegral p) wordAt iMin iMax-          s = (i !!! q) :: Count-          wordAt = (i !!!)-          (sampleMin, sampleMax) = sampleRange iv p-          iMin = fromIntegral $  (sampleMin - 1) `div` 512      :: Position-          iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position--instance OpenAt Poppy512S where-  openAt = openAt . poppy512SBits-  {-# INLINE openAt #-}--instance CloseAt Poppy512S where-  closeAt = closeAt . poppy512SBits-  {-# INLINE closeAt #-}--instance NewCloseAt Poppy512S where-  newCloseAt = newCloseAt . poppy512SBits-  {-# INLINE newCloseAt #-}--instance FindOpenN Poppy512S where-  findOpenN = findOpenN . poppy512SBits-  {-# INLINE findOpenN #-}--instance FindOpen Poppy512S where-  findOpen = findOpen . poppy512SBits-  {-# INLINE findOpen #-}--instance FindClose Poppy512S where-  findClose = findClose . poppy512SBits-  {-# INLINE findClose #-}--instance FindCloseN Poppy512S where-  findCloseN = findCloseN . poppy512SBits-  {-# INLINE findCloseN #-}--instance Enclose Poppy512S where-  enclose = enclose . poppy512SBits-  {-# INLINE enclose #-}--instance BalancedParens Poppy512S where-  firstChild  = firstChild  . poppy512SBits-  nextSibling = nextSibling . poppy512SBits-  parent      = parent      . poppy512SBits-  {-# INLINE firstChild  #-}-  {-# INLINE nextSibling #-}-  {-# INLINE parent      #-}

@@ -7,98 +7,116 @@   , genRank1Select1Spec   ) where -import           Data.Maybe-import           Data.Typeable-import           Data.Word-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select0-import           HaskellWorks.Data.RankSelect.Base.Select1-import           Test.Hspec+import Data.Maybe+import Data.Typeable+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-} -genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec+genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Show s) => s -> Spec genRank0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank0 10010010 over [0..8] should be 001223445" $ do+  it "rank0 10010010 over [0..8] should be 001223445" $ requireProperty $ do     let bs = fromJust (bitRead "10010010") :: s-    fmap (rank0 bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]+    _ <- forAll $ pure bs+    fmap (rank0 bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5] -genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec+genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Show s) => s -> Spec genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank0 11011010 00000000 over [0..16]" $ do+  it "rank0 11011010 00000000 over [0..16]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 00000000" :: s-    fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]-  it "rank0 11011010 10000000 over [0..16]" $ do+    _ <- forAll $ pure bs+    fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]+  it "rank0 11011010 10000000 over [0..16]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 10000000" :: s-    fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10]+    _ <- forAll $ pure bs+    fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10] -genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Show s) => s -> Spec genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank1 10010010 over [0..8] should be 011122233" $ do+  it "rank1 10010010 over [0..8] should be 011122233" $ requireProperty $ do     let bs = fromJust (bitRead "10010010") :: s-    fmap (rank1 bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]+    _ <- forAll $ pure bs+    fmap (rank1 bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3] -genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Show s) => s -> Spec genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank1 11011010 00000000 over [0..9]" $ do+  it "rank1 11011010 00000000 over [0..9]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 00000000" :: s-    fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5]-  it "rank1 11011010 10000000 over [0..9]" $ do+    _ <- forAll $ pure bs+    fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5]+  it "rank1 11011010 10000000 over [0..9]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 10000000" :: s-    fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6]+    _ <- forAll $ pure bs+    fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6] -genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s, Show s) => s -> Spec genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select0 10010010 over [0..5] should be 023568" $ do+  it "select0 10010010 over [0..5] should be 023568" $ requireProperty $ do     let bs = fromJust $ bitRead "10010010" :: Word8-    fmap (select0 bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]+    _ <- forAll $ pure bs+    fmap (select0 bs) [0..5] === [0, 2, 3, 5, 6, 8] -genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 s, Show s) => s -> Spec genSelect0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select0 11011010 00 over [0..5]" $-    let bs = fromJust $ bitRead "1101101 000" :: [Bool] in-    fmap (select0 bs) [0..5] `shouldBe` [0, 3, 6, 8, 9, 10]-  it "select0 11011010 00000000 over [0..5]" $ do+  it "select0 11011010 00 over [0..5]" $ requireProperty $ do+    let bs = fromJust $ bitRead "1101101 000" :: [Bool]+    _ <- forAll $ pure bs+    fmap (select0 bs) [0..5] === [0, 3, 6, 8, 9, 10]+  it "select0 11011010 00000000 over [0..5]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 00000000" :: Word32-    fmap (select0 bs) [0..11] `shouldBe` [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16]+    _ <- forAll $ pure bs+    fmap (select0 bs) [0..11] === [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16] -genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s, Show s) => s -> Spec genSelect0UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $-    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in-    fmap (select0 bs) [0..19] `shouldBe` [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24]+  it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do+    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s+    _ <- forAll $ pure bs+    fmap (select0 bs) [0..19] === [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24] -genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select1 10010010 over [0..3] should be 0147" $ do+  it "select1 10010010 over [0..3] should be 0147" $ requireProperty $ do     let bs = fromJust $ bitRead "10010010" :: s-    fmap (select1 bs) [0..3] `shouldBe` [0, 1, 4, 7]+    _ <- forAll $ pure $ bs+    fmap (select1 bs) [0..3] === [0, 1, 4, 7] -genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec genSelect1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select1 11011010 00 over [0..5]" $-    let bs = fromJust $ bitRead "11011010 00" :: s in-    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]-  it "select1 11011010 00000000 over [0..5]" $ do+  it "select1 11011010 00 over [0..5]" $ requireProperty $ do+    let bs = fromJust $ bitRead "11011010 00" :: s+    _ <- forAll $ pure bs+    fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7]+  it "select1 11011010 00000000 over [0..5]" $ requireProperty $ do     let bs = fromJust $ bitRead "11011010 00000000" :: s-    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]-  it "select 01000000 00000100 over [0..2]" $ do+    _ <- forAll $ pure bs+    fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7]+  it "select 01000000 00000100 over [0..2]" $ requireProperty $ do     let bs = fromJust $ bitRead "01000000 00000100" :: s-    fmap (select1 bs) [0..2] `shouldBe` [0, 2, 14]+    _ <- forAll $ pure bs+    fmap (select1 bs) [0..2] === [0, 2, 14] -genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s, Show s) => s -> Spec genSelect1UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $-    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in-    fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 8, 9, 18]-  it "select 10000010 00000000 00100000 00010000 over [0..4]" $ do+  it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do+    let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s+    _ <- forAll $ pure bs+    fmap (select1 bs) [0..5] === [0, 1, 2, 8, 9, 18]+  it "select 10000010 00000000 00100000 00010000 over [0..4]" $ requireProperty $ do     let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s-    fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28]+    _ <- forAll $ pure bs+    fmap (select1 bs) [0..4] === [0, 1, 7, 19, 28] -genRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec+genRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s, Show s) => s -> Spec genRank1Select1Spec s = describe "For Rank 1" $ do   genRank1UpTo8Spec     s   genRank1UpTo16Spec    s@@ -106,7 +124,7 @@   genSelect1UpTo16Spec  s   genSelect1UpTo32Spec  s -genRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s) => s -> Spec+genRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s, Show s) => s -> Spec genRank0Select0Spec s = describe "For Rank 0" $ do   genRank0UpTo8Spec     s   genRank0UpTo16Spec    s@@ -114,7 +132,7 @@   genSelect0UpTo16Spec  s   genSelect0UpTo32Spec  s -genRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec+genRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s, Show s) => s -> Spec genRankSelectSpec s = describe "Generically" $ do   genRank1Select1Spec    s   genRank0Select0Spec    s

@@ -6,11 +6,11 @@ import HaskellWorks.Data.RankSelect.CsPoppy.Internal import HaskellWorks.Hspec.Hedgehog import Hedgehog-import Prelude                                        hiding (length)+import Prelude                                       hiding (length) import Test.Hspec -import qualified Hedgehog.Gen              as G-import qualified Hedgehog.Range            as R+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) #-}@@ -18,7 +18,7 @@ spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.CsInterleavedSpec" $ do   describe "Interleaved Level 1 & 2" $ do-    it "have all its fields isolated" $ require $ property $ do+    it "have all its fields isolated" $ requireProperty $ do       vx <- forAll $ G.word64 R.constantBounded       va <- forAll $ G.word64 R.constantBounded       vb <- forAll $ G.word64 R.constantBounded@@ -31,7 +31,7 @@       getCsiA (putCsiA va actual) === (va .&. 0x3ff)       getCsiB (putCsiB vb actual) === (vb .&. 0x3ff)       getCsiC (putCsiC vc actual) === (vc .&. 0x3ff)-    it "have all its fields isolated" $ require $ property $ do+    it "have all its fields isolated" $ requireProperty $ do       vx <- forAll $ G.word64 R.constantBounded       va <- forAll $ G.word64 R.constantBounded       vb <- forAll $ G.word64 R.constantBounded

@@ -23,7 +23,7 @@ import HaskellWorks.Data.Take import HaskellWorks.Hspec.Hedgehog import Hedgehog-import Prelude hiding (length, take, drop)+import Prelude                                   hiding (drop, length, take) import System.Directory import System.IO.MMap import System.IO.Unsafe@@ -61,17 +61,17 @@       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       let i = 0       rank1 v i === rank1 w i-    it "on one basic block" $ require $ property $ do+    it "on one basic block" $ requireProperty $ do       v       <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded)       i       <- forAll $ G.word64 (R.linear 0 (length v * 8))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       rank1 v i === rank1 w i-    it "on two basic blocks" $ require $ property $ do+    it "on two basic blocks" $ requireProperty $ do       v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded)       i <- forAll $ G.word64 (R.linear 0 (length v * 8))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       rank1 v i === rank1 w i-    it "on three basic blocks" $ require $ property $ do+    it "on three basic blocks" $ requireProperty $ do       v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded)       i <- forAll $ G.word64 (R.linear 0 (length v * 8))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v@@ -86,34 +86,34 @@       let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       select1 w 0 === select1 v 0-    xit "on one basic block" $ require $ property $ do+    xit "on one basic block" $ requireProperty $ do       v <- forAll $ G.storableVector (R.linear 1 8) (G.word64 R.constantBounded)       i <- forAll $ G.word64 (R.linear 0 (popCount1 v))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       select1 w i === select1 v i-    xit "on two basic blocks" $ require $ property $ do+    xit "on two basic blocks" $ requireProperty $ do       v <- forAll $ G.storableVector (R.linear 9 16) (G.word64 R.constantBounded)       i <- forAll $ G.word64 (R.linear 0 (popCount1 v))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       select1 w i === select1 v i-    xit "on three basic blocks" $ require $ property $ do+    xit "on three basic blocks" $ requireProperty $ do       v <- forAll $ G.storableVector (R.linear 17 24) (G.word64 R.constantBounded)       i <- forAll $ G.word64 (R.linear 0 (popCount1 v))       Nice w  <- forAll $ pure $ Nice $ makeCsPoppy v       select1 w i === select1 v i   describe "Rank select over large buffer" $ do-    xit "Rank works" $ require $ property $ do+    xit "Rank works" $ requireProperty $ do       let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64       let ps = makeCsPoppy cs       (rank1 ps `map` [1 .. 4096]) === [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]-    xit "Rank is consistent with pop count" $ require $ property $ do+    xit "Rank is consistent with pop count" $ requireProperty $ do       v         <- forAll $ G.storableVector (R.linear 0 1024) (G.word64 R.constantBounded)       Nice rsbs <- forAll $ pure $ Nice (makeCsPoppy v)       rank1 rsbs (bitLength rsbs) === popCount1 rsbs     it "Select works" $ do       let v = DVS.fromList [0x1101001000100001, 0x2202002000200002, 0x3303003000300003] :: DVS.Vector Word64       let pc = popCount1 v-      require $ property $ do+      requireProperty $ do         Nice csPoppy  <- forAll $ pure $ Nice (makeCsPoppy v)         s             <- forAll $ G.word64 (R.linear 1 pc)         select1 csPoppy s === select1 v s@@ -122,7 +122,7 @@       forM_ corpusFiles $ \corpusFile -> do         xit corpusFile $ do           fileV <- liftIO $ loadVector64 corpusFile-          require $ property $ do+          requireProperty $ do             let v = DVS.take 768 fileV             Nice csPoppy  <- forAll $ pure $ Nice $ makeCsPoppy v             maxPos        <- forAll $ pure $ fromIntegral $ DVS.length (csPoppyBits csPoppy)@@ -134,7 +134,7 @@           v <- liftIO $ loadVector64 corpusFile           let csPoppy = makeCsPoppy v           let maxPos = fromIntegral $ DVS.length (csPoppyBits csPoppy)-          require $ property $ do+          requireProperty $ do             r <- forAll $ G.word64 (R.linear 1 maxPos)             rank1 csPoppy r === rank1 v r     describe "Select" $ do@@ -143,7 +143,7 @@           fileV <- liftIO $ loadVector64 corpusFile           let csPoppy = makeCsPoppy fileV           let pc = popCount1 (csPoppyBits csPoppy)-          require $ property $ do+          requireProperty $ do             _ <- forAll $ pure $ Nice csPoppy             s <- forAll $ G.word64 (R.linear 1 pc)             select1 csPoppy s === select1 fileV s@@ -153,7 +153,7 @@           fileV <- liftIO $ loadVector64 corpusFile           let csPoppy = makeCsPoppy fileV           let pc = popCount1 (csPoppyBits csPoppy)-          require $ property $ do+          requireProperty $ do             _ <- forAll $ pure $ csPoppyLayerS csPoppy             s <- forAll $ G.word64 (R.linear 1 pc)             select1 csPoppy s === select1 fileV s

@@ -0,0 +1,15 @@++module HaskellWorks.Data.RankSelect.Gen where++import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.SpecCommon+import Hedgehog++import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen         as G++count :: MonadGen m => Range Count -> m Count+count = G.word64++vector :: (MonadGen m, DVS.Storable a) => Range Int -> m a -> m (ShowVector (DVS.Vector a))+vector r g = ShowVector . DVS.fromList <$> G.list r g

@@ -3,33 +3,37 @@  module HaskellWorks.Data.RankSelect.InternalSpec (spec) where -import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.PopCount.PopCount1-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank-import           HaskellWorks.Data.RankSelect.Base.Select-import           Test.Hspec-import           Test.QuickCheck+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.RankSelect.Base.Rank+import HaskellWorks.Data.RankSelect.Base.Select+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Prelude                                   hiding (length)+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.InternalSpec" $ do   describe "For [Bool]" $ do-    it "rank True 10010010 over [0..8] should be 011122233" $-      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in-      fmap (rank True bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]-    it "rank True 10010010 over [0..8] should be 001223445" $-      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in-      fmap (rank False bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]-    it "select True 10010010 over [0..3] should be 0147" $-      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in-      fmap (select True bs) [0..3] `shouldBe` [0, 1, 4, 7]-    it "select False 10010010 over [0..5] should be 023568" $-      let (Just bs) = bitRead "10010010" :: Maybe [Bool] in-      fmap (select False bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]-    it "Rank and select form a galois connection" $-      property $ \(bs :: [Bool]) ->-      forAll (choose (0, popCount1 bs)) $ \(c :: Count) ->-        rank True bs (select True bs c) == c+    it "rank True 10010010 over [0..8] should be 011122233" $ requireProperty $ do+      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      fmap (rank True bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3]+    it "rank True 10010010 over [0..8] should be 001223445" $ requireProperty $ do+      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      fmap (rank False bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5]+    it "select True 10010010 over [0..3] should be 0147" $ requireProperty $ do+      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      fmap (select True bs) [0..3] === [0, 1, 4, 7]+    it "select False 10010010 over [0..5] should be 023568" $ requireProperty $ do+      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      fmap (select False bs) [0..5] === [0, 2, 3, 5, 6, 8]+    it "Rank and select form a galois connection" $ requireProperty $ do+      bs <- forAll $ G.list (R.linear 0 70) G.bool+      c  <- forAll $ G.word64 (R.linear 0 (popCount1 bs))+      rank True bs (select True bs c) === c

@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving       #-}-{-# LANGUAGE ScopedTypeVariables              #-}--module HaskellWorks.Data.RankSelect.Poppy512SSpec (spec) where--import           GHC.Exts-import           Data.Maybe-import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Bits.PopCount.PopCount1-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select1-import           HaskellWorks.Data.RankSelect.BasicGen-import           HaskellWorks.Data.RankSelect.Poppy512S-import           Prelude hiding (length)-import           Test.Hspec-import           Test.QuickCheck--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}--newtype ShowVector a = ShowVector a deriving (Eq, BitShow)--instance BitShow a => Show (ShowVector a) where-  show = bitShow--vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))-vectorSizedBetween a b = do-  n   <- choose (a, b)-  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]-  return $ ShowVector (fromList xs)--spec :: Spec-spec = describe "HaskellWorks.Data.RankSelect.Poppy512S.Rank1Spec" $ do-  genRank1Select1Spec (undefined :: Poppy512S)-  describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512S" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512S v in-      let i = 0 in-      rank1 v i === rank1 w i-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512S v in-      rank1 v i === rank1 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512S v in-      rank1 v i === rank1 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512S v in-      rank1 v i === rank1 w i-  describe "select1 for Vector Word64 is equivalent to select1 for Poppy512S" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512S v in-      let i = 0 in-      select1 v i === select1 w i-    it "on one full zero basic block" $-      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in-      let w = makePoppy512S v in-      select1 v 0 === select1 w 0-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512S v in-      select1 v i === select1 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512S v in-      select1 v i === select1 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512S v in-      select1 v i === select1 w i-  describe "Rank select over large buffer" $ do-    it "Rank works" $ do-      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64-      let ps = makePoppy512S cs-      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]-    it "Select works" $ do-      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64-      let ps = makePoppy512S cs-      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -1,143 +1,136 @@ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.RankSelect.Poppy512Spec (spec) where -import           GHC.Exts-import           Data.Maybe-import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Bits.PopCount.PopCount0-import           HaskellWorks.Data.Bits.PopCount.PopCount1-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select0-import           HaskellWorks.Data.RankSelect.Base.Select1-import           HaskellWorks.Data.RankSelect.BasicGen-import           HaskellWorks.Data.RankSelect.Poppy512-import           Prelude hiding (length)-import           Test.Hspec-import           Test.QuickCheck+import Data.Maybe+import Data.Word+import GHC.Exts+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.BasicGen+import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.RankSelect.SpecCommon+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Prelude                                   hiding (length)+import Test.Hspec +import qualified Data.Vector.Storable             as DVS+import qualified HaskellWorks.Data.RankSelect.Gen as G+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) #-} -newtype ShowVector a = ShowVector a deriving (Eq, BitShow)--instance BitShow a => Show (ShowVector a) where-  show = bitShow--vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))-vectorSizedBetween a b = do-  n   <- choose (a, b)-  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]-  return $ ShowVector (fromList xs)- spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.Poppy512.Rank1Spec" $ do   genRankSelectSpec (undefined :: Poppy512)   describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512 v in-      let i = 0 in+    it "on empty bitvector" $ requireProperty $ do+      let v = DVS.empty+      let w = makePoppy512 v+      let i = 0       rank1 v i === rank1 w i-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on one basic block" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank1 v i === rank1 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on two basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank1 v i === rank1 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on three basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank1 v i === rank1 w i   describe "rank0 for Vector Word64 is equivalent to rank0 for Poppy512" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512 v in-      let i = 0 in+    it "on empty bitvector" $ requireProperty $ do+      let v = DVS.empty+      let w = makePoppy512 v+      let i = 0       rank0 v i === rank0 w i-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on one basic block" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank0 v i === rank0 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on two basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank0 v i === rank0 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, length v * 8)) $ \i ->-      let w = makePoppy512 v in+    it "on three basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (length v * 8))+      let w = makePoppy512 v       rank0 v i === rank0 w i   describe "select0 for Vector Word64 is equivalent to select0 for Poppy512" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512 v in-      let i = 0 in+    it "on empty bitvector" $ requireProperty $ do+      let v = DVS.empty+      let w = makePoppy512 v+      let i = 0       select0 v i === select0 w i-    it "on one full zero basic block" $-      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in-      let w = makePoppy512 v in+    it "on one full zero basic block" $ requireProperty $ do+      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64+      let w = makePoppy512 v       select0 v 0 === select0 w 0-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, popCount0 v)) $ \i ->-      let w = makePoppy512 v in+    it "on one basic block" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount0 v))+      let w = makePoppy512 v       select0 v i === select0 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, popCount0 v)) $ \i ->-      let w = makePoppy512 v in+    it "on two basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount0 v))+      let w = makePoppy512 v       select0 v i === select0 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, popCount0 v)) $ \i ->-      let w = makePoppy512 v in+    it "on three basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount0 v))+      let w = makePoppy512 v       select0 v i === select0 w i   describe "select1 for Vector Word64 is equivalent to select1 for Poppy512" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makePoppy512 v in-      let i = 0 in+    it "on empty bitvector" $ requireProperty $ do+      let v = DVS.empty+      let w = makePoppy512 v+      let i = 0       select1 v i === select1 w i-    it "on one full zero basic block" $-      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in-      let w = makePoppy512 v in+    it "on one full zero basic block" $ requireProperty $ do+      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64+      let w = makePoppy512 v       select1 v 0 === select1 w 0-    it "on one basic block" $-      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512 v in+    it "on one basic block" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 1 8) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount1 v))+      let w = makePoppy512 v       select1 v i === select1 w i-    it "on two basic blocks" $-      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512 v in+    it "on two basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 9 16) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount1 v))+      let w = makePoppy512 v       select1 v i === select1 w i-    it "on three basic blocks" $-      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->-      forAll (choose (0, popCount1 v)) $ \i ->-      let w = makePoppy512 v in+    it "on three basic blocks" $ requireProperty $ do+      ShowVector v  <- forAll $ G.vector (R.linear 17 24) (G.word64 R.constantBounded)+      i             <- forAll $ G.word64 (R.linear 0 (popCount1 v))+      let w = makePoppy512 v       select1 v i === select1 w i   describe "Rank select over large buffer" $ do-    it "Rank works" $ do+    it "Rank works" $ requireProperty $ do       let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64       let ps = makePoppy512 cs-      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]-    it "Select works" $ do+      (rank1 ps `map` [1 .. 4096]) === [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]+    it "Select works" $ requireProperty $ do       let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64       let ps = makePoppy512 cs-      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]+      (select1 ps `map` [1 .. 2048]) === [1, 3 .. 4096]

@@ -3,50 +3,67 @@  module HaskellWorks.Data.RankSelect.SimpleSpec (spec) where -import           Data.Vector-import           Data.Word-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           Test.Hspec-import           Test.QuickCheck+import Data.Vector+import Data.Word+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec +import qualified HaskellWorks.Data.RankSelect.Gen as G+import qualified Hedgehog.Gen                     as G+import qualified Hedgehog.Range                   as R+ {-# ANN module ("HLint: ignore Redundant do" :: String) #-}  spec :: Spec spec = describe "HaskellWorks.Data.SuccinctSpec" $ do-  it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $-    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word8) (b :: Word8) (c :: Word8) (d :: Word8)-                                            (e :: Word8) (f :: Word8) (g :: Word8) (h :: Word8) ->-      let a64 = fromIntegral a :: Word64 in-      let b64 = fromIntegral b :: Word64 in-      let c64 = fromIntegral c :: Word64 in-      let d64 = fromIntegral d :: Word64 in-      let e64 = fromIntegral e :: Word64 in-      let f64 = fromIntegral f :: Word64 in-      let g64 = fromIntegral g :: Word64 in-      let h64 = fromIntegral h :: Word64 in-      let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|.-                       (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|.  a64              in-      let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 )             in-      let vec64 = BitShown (fromList [abcdefgh64]             :: Vector Word64)             in-      rank1 vec16 i == rank1 vec64 i-  it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $-    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word16) (b :: Word16) (c :: Word16) (d :: Word16) ->-      let a64 = fromIntegral a :: Word64 in-      let b64 = fromIntegral b :: Word64 in-      let c64 = fromIntegral c :: Word64 in-      let d64 = fromIntegral d :: Word64 in-      let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64 in-      let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16) in-      let vec64 = BitShown (fromList [abcd64]     :: Vector Word64) in-      rank1 vec16 i == rank1 vec64 i-  it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $-    forAll (choose (0, 64)) $ \(i :: Count) (a :: Word32) (b :: Word32) ->-      let a64 = fromIntegral a :: Word64 in-      let b64 = fromIntegral b :: Word64 in-      let ab64 = (b64 .<. 32) .|. a64 in-      let vec32 = BitShown (fromList [a, b] :: Vector Word32) in-      let vec64 = BitShown (fromList [ab64] :: Vector Word64) in-      rank1 vec32 i == rank1 vec64 i+  it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do+    i <- forAll $ G.count $ R.linear 0 64+    a <- forAll $ G.word8 $ R.constantBounded+    b <- forAll $ G.word8 $ R.constantBounded+    c <- forAll $ G.word8 $ R.constantBounded+    d <- forAll $ G.word8 $ R.constantBounded+    e <- forAll $ G.word8 $ R.constantBounded+    f <- forAll $ G.word8 $ R.constantBounded+    g <- forAll $ G.word8 $ R.constantBounded+    h <- forAll $ G.word8 $ R.constantBounded+    let a64 = fromIntegral a :: Word64+    let b64 = fromIntegral b :: Word64+    let c64 = fromIntegral c :: Word64+    let d64 = fromIntegral d :: Word64+    let e64 = fromIntegral e :: Word64+    let f64 = fromIntegral f :: Word64+    let g64 = fromIntegral g :: Word64+    let h64 = fromIntegral h :: Word64+    let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|.+                     (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|.  a64+    let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 )+    let vec64 = BitShown (fromList [abcdefgh64]             :: Vector Word64)+    rank1 vec16 i === rank1 vec64 i+  it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do+    i <- forAll $ G.count $ R.linear 0 64+    a <- forAll $ G.word16 $ R.constantBounded+    b <- forAll $ G.word16 $ R.constantBounded+    c <- forAll $ G.word16 $ R.constantBounded+    d <- forAll $ G.word16 $ R.constantBounded+    let a64 = fromIntegral a :: Word64+    let b64 = fromIntegral b :: Word64+    let c64 = fromIntegral c :: Word64+    let d64 = fromIntegral d :: Word64+    let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64+    let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16)+    let vec64 = BitShown (fromList [abcd64]     :: Vector Word64)+    rank1 vec16 i === rank1 vec64 i+  it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $ require $ withTests 1 $ property $ do+    i <- forAll $ G.count $ R.linear 0 64+    a <- forAll $ G.word32 $ R.constantBounded+    b <- forAll $ G.word32 $ R.constantBounded+    let a64 = fromIntegral a :: Word64+    let b64 = fromIntegral b :: Word64+    let ab64 = (b64 .<. 32) .|. a64+    let vec32 = BitShown (fromList [a, b] :: Vector Word32)+    let vec64 = BitShown (fromList [ab64] :: Vector Word64)+    rank1 vec32 i === rank1 vec64 i

@@ -0,0 +1,10 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HaskellWorks.Data.RankSelect.SpecCommon where++import HaskellWorks.Data.Bits.BitShow++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow