hw-rankselect 0.5.0.0 → 0.6.0.0

raw patch · 48 files changed

+1141/−3362 lines, 48 filesdep +hw-balancedparensdep −bytestringdep −conduitdep −criteriondep ~hw-primPVP ok

version bump matches the API change (PVP)

Dependencies added: hw-balancedparens

Dependencies removed: bytestring, conduit, criterion, mmap

Dependency ranges changed: hw-prim

API changes (from Hackage documentation)

Files

• app/Main.hs +0/−4
• bench/Main.hs +0/−76
• hw-rankselect.cabal +13/−60
• src/HaskellWorks/Data/RankSelect/CsPoppy.hs +120/−0
• src/HaskellWorks/Data/RankSelect/CsPoppy2.hs +111/−0
• src/HaskellWorks/Data/RankSelect/Poppy512.hs +122/−0
• src/HaskellWorks/Data/RankSelect/Poppy512S.hs +143/−0
• src/HaskellWorks/Data/Succinct/BalancedParens.hs +0/−13
• src/HaskellWorks/Data/Succinct/BalancedParens/BalancedParens.hs +0/−65
• src/HaskellWorks/Data/Succinct/BalancedParens/Broadword.hs +0/−199
• src/HaskellWorks/Data/Succinct/BalancedParens/CloseAt.hs +0/−73
• src/HaskellWorks/Data/Succinct/BalancedParens/Enclose.hs +0/−59
• src/HaskellWorks/Data/Succinct/BalancedParens/FindClose.hs +0/−70
• src/HaskellWorks/Data/Succinct/BalancedParens/FindCloseN.hs +0/−71
• src/HaskellWorks/Data/Succinct/BalancedParens/FindOpen.hs +0/−60
• src/HaskellWorks/Data/Succinct/BalancedParens/FindOpenN.hs +0/−71
• src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs +0/−60
• src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs +0/−59
• src/HaskellWorks/Data/Succinct/BalancedParens/OpenAt.hs +0/−69
• src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs +0/−239
• src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2.hs +0/−322
• src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +0/−32
• src/HaskellWorks/Data/Succinct/EliasFano64.hs +0/−64
• src/HaskellWorks/Data/Succinct/EliasFano64/Internal.hs +0/−53
• src/HaskellWorks/Data/Succinct/NearestNeighbour.hs +0/−14
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs +0/−120
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs +0/−111
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +0/−122
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs +0/−143
• test/HaskellWorks/Data/RankSelect/BasicGen.hs +120/−0
• test/HaskellWorks/Data/RankSelect/CsPoppy2Spec.hs +94/−0
• test/HaskellWorks/Data/RankSelect/CsPoppySpec.hs +94/−0
• test/HaskellWorks/Data/RankSelect/InternalSpec.hs +35/−0
• test/HaskellWorks/Data/RankSelect/Poppy512SSpec.hs +94/−0
• test/HaskellWorks/Data/RankSelect/Poppy512Spec.hs +143/−0
• test/HaskellWorks/Data/RankSelect/SimpleSpec.hs +52/−0
• test/HaskellWorks/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs +0/−137
• test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2Spec.hs +0/−152
• test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs +0/−62
• test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs +0/−135
• test/HaskellWorks/Data/Succinct/EliasFano64Spec.hs +0/−15
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs +0/−120
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs +0/−94
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs +0/−94
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs +0/−94
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs +0/−143
• test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs +0/−35
• test/HaskellWorks/Data/Succinct/SimpleSpec.hs +0/−52

@@ -1,4 +0,0 @@-module Main where--main :: IO ()-main = putStrLn "Hello world"

@@ -1,76 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import           Criterion.Main-import qualified Data.Vector.Storable                                   as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.Broadword-import           HaskellWorks.Data.Bits.FromBitTextByteString-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.RankSelect.Base-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax--setupEnvVector :: Int -> IO (DVS.Vector Word64)-setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))--setupEnvRmmVector :: Int -> IO (RangeMinMax (DVS.Vector Word64))-setupEnvRmmVector n = return $ mkRangeMinMax $ DVS.fromList (take n (cycle [maxBound, 0]))--setupEnvBP2 :: IO Word64-setupEnvBP2 = return $ DVS.head (fromBitTextByteString "10")--setupEnvBP4 :: IO Word64-setupEnvBP4 = return $ DVS.head (fromBitTextByteString "1100")--setupEnvBP8 :: IO Word64-setupEnvBP8 = return $ DVS.head (fromBitTextByteString "11101000")--setupEnvBP16 :: IO Word64-setupEnvBP16 = return $ DVS.head (fromBitTextByteString "11111000 11100000")--setupEnvBP32 :: IO Word64-setupEnvBP32 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11100000")--setupEnvBP64 :: IO Word64-setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000")--benchRankSelect :: [Benchmark]-benchRankSelect =-  [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit"-    [ bench "Broadword"     (whnf (findClose (Broadword w)) 1)-    , bench "Naive"         (whnf (findClose (Naive     w)) 1)-    ]-  , env (setupEnvVector 1000000) $ \bv -> bgroup "RangeMinMax"-    [ bench "findClose"   (nf   (map (findClose bv)) [0, 1000..10000000])-    ]-  , env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"-    [ bench "Rank - Once"   (whnf (rank1    bv) 1)-    , bench "Select - Once" (whnf (select1  bv) 1)-    , bench "Rank - Many"   (nf   (map (rank1 bv)) [0, 1000..10000000])-    ]-  ]--main :: IO ()-main = defaultMain benchRankSelect

@@ -1,5 +1,5 @@ name:                   hw-rankselect-version:                0.5.0.0+version:                0.6.0.0 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-rankselect#readme@@ -13,39 +13,14 @@ extra-source-files:     README.md cabal-version:          >= 1.22 -executable hw-rankselect-example-  hs-source-dirs:       app-  main-is:              Main.hs-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2-  build-depends:        base                          >= 4          && < 5-                      , hw-rankselect-  default-language:     Haskell2010- library   hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.Succinct.BalancedParens-                      , HaskellWorks.Data.Succinct.BalancedParens.BalancedParens-                      , HaskellWorks.Data.Succinct.BalancedParens.Broadword-                      , HaskellWorks.Data.Succinct.BalancedParens.CloseAt-                      , HaskellWorks.Data.Succinct.BalancedParens.Enclose-                      , HaskellWorks.Data.Succinct.BalancedParens.FindClose-                      , HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-                      , HaskellWorks.Data.Succinct.BalancedParens.FindOpen-                      , HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-                      , HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-                      , HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt-                      , HaskellWorks.Data.Succinct.BalancedParens.OpenAt-                      , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax-                      , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2-                      , HaskellWorks.Data.Succinct.BalancedParens.Simple-                      , HaskellWorks.Data.Succinct.EliasFano64-                      , HaskellWorks.Data.Succinct.EliasFano64.Internal-                      , HaskellWorks.Data.Succinct.NearestNeighbour-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S+  exposed-modules:      HaskellWorks.Data.RankSelect.CsPoppy+                      , HaskellWorks.Data.RankSelect.CsPoppy2+                      , HaskellWorks.Data.RankSelect.Poppy512+                      , HaskellWorks.Data.RankSelect.Poppy512S   build-depends:        base                          >= 4          && < 5+                      , hw-balancedparens             >= 0.0.0.1                       , hw-bits                       >= 0.3.0.0                       , hw-excess                     >= 0.0.0.1                       , hw-prim                       >= 0.3.0.5@@ -61,18 +36,13 @@   type:                 exitcode-stdio-1.0   hs-source-dirs:       test   main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.Succinct.BalancedParens.Internal.BroadwordSpec-                      , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec-                      , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2Spec-                      , HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec-                      , HaskellWorks.Data.Succinct.EliasFano64Spec-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppySpec-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2Spec-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec-                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512SSpec-                      , HaskellWorks.Data.Succinct.RankSelect.InternalSpec-                      , HaskellWorks.Data.Succinct.SimpleSpec+  other-modules:        HaskellWorks.Data.RankSelect.BasicGen+                      , HaskellWorks.Data.RankSelect.CsPoppySpec+                      , HaskellWorks.Data.RankSelect.CsPoppy2Spec+                      , HaskellWorks.Data.RankSelect.Poppy512Spec+                      , HaskellWorks.Data.RankSelect.Poppy512SSpec+                      , HaskellWorks.Data.RankSelect.InternalSpec+                      , HaskellWorks.Data.RankSelect.SimpleSpec   build-depends:        base                          >= 4          && < 5                       , hspec                       , hw-bits                       >= 0.3.0.0@@ -87,20 +57,3 @@ source-repository head   type:     git   location: https://github.com/haskell-works/hw-rankselect--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-                      , hw-bits                       >= 0.3.0.0-                      , hw-prim                       >= 0.3.0.5-                      , hw-rankselect-                      , hw-rankselect-base            >= 0.1.0.0-                      , mmap-                      , vector

@@ -0,0 +1,120 @@+module HaskellWorks.Data.RankSelect.CsPoppy+    ( CsPoppy(..)+    , Rank1(..)+    , makeCsPoppy+    , sampleRange+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.AtIndex+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.Rank1+import           HaskellWorks.Data.RankSelect.Base.Select1+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.Vector.AsVector64++data CsPoppy = CsPoppy+  { csPoppyBits     :: DVS.Vector Word64+  , csPoppy512Index :: DVS.Vector Word64+  , csPoppyLayer0   :: DVS.Vector Word64+  , csPoppyLayer1   :: DVS.Vector Word64+  , csPoppyLayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit+  } deriving (Eq, Show)++instance AsVector64 CsPoppy where+  asVector64 = asVector64 . csPoppyBits+  {-# INLINE asVector64 #-}++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count+popCount1Range start len = popCount1 . DVS.take len . DVS.drop start++makeCsPoppy :: DVS.Vector Word64 -> CsPoppy+makeCsPoppy v = CsPoppy+  { csPoppyBits     = v+  , csPoppy512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index+  , csPoppyLayer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0+  , csPoppyLayer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1+  , csPoppyLayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)+  }+  where csPoppyCum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048+        gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else popCount1Range (indexN *           8)           8 v + DVS.last u+        genCum2048 u = let indexN = DVS.length u in+          if indexN .&. 0xffffffff == 0+            then 0+            else popCount1Range ((indexN - 1) *    32)          32 v + DVS.last u+        genLayer0 u = let indexN = DVS.length u in+          if indexN == 0+            then 0+            else popCount1Range (indexN * 0x100000000) 0x100000000 v + DVS.last u+        genLayer1 u = let indexN = DVS.length u in+          let cum = if indexN == 0 -- TODO Check boundary at 4G???+              then  0+              else  csPoppyCum2048 !!! fromIntegral indexN in+          let a = popCount1Range (indexN * 32 +  0) 8 v in+          let b = popCount1Range (indexN * 32 +  8) 8 v in+          let c = popCount1Range (indexN * 32 + 16) 8 v in+          (   ( cum       .&. 0x00000000ffffffff)+          .|. ((a .<. 32) .&. 0x000003ff00000000)+          .|. ((b .<. 42) .&. 0x000ffc0000000000)+          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)+        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          else Nothing++instance TestBit CsPoppy where+  (.?.) = (.?.) . csPoppyBits+  {-# INLINE (.?.) #-}++instance BitRead CsPoppy where+  bitRead = fmap makeCsPoppy . bitRead++instance Rank1 CsPoppy where+  rank1 (CsPoppy v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock+    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)+          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)+          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff+          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32+          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42+          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52+          q                       = (p `div` 512) `mod` 4 -- quarter+          rankLayer1  | q == 0    = rankLayer1A+                      | q == 1    = rankLayer1A + rankLayer1B+                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C+                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D+                      | otherwise = undefined+          rankPrior               = (rankLayer0 + rankLayer1) :: Count+          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Select1 CsPoppy where+  select1 iv@(CsPoppy 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++sampleRange :: CsPoppy -> Count -> (Word64, Word64)+sampleRange (CsPoppy _ 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))

@@ -0,0 +1,111 @@+module HaskellWorks.Data.RankSelect.CsPoppy2+    ( CsPoppy2(..)+    , Rank1(..)+    , makeCsPoppy2+    , sampleRange+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.AtIndex+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.Rank1+import           HaskellWorks.Data.RankSelect.Base.Select1+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.Vector.AsVector64++data CsPoppy2 = CsPoppy2+  { csPoppy2Bits     :: DVS.Vector Word64+  , csPoppy2512Index :: DVS.Vector Word64+  , csPoppy2Layer0   :: DVS.Vector Word64+  , csPoppy2Layer1   :: DVS.Vector Word64+  , csPoppy2LayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit+  } deriving (Eq, Show)++instance AsVector64 CsPoppy2 where+  asVector64 = asVector64 . csPoppy2Bits+  {-# INLINE asVector64 #-}++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count+popCount1Range start len = popCount1 . DVS.take len . DVS.drop start++makeCsPoppy2 :: DVS.Vector Word64 -> CsPoppy2+makeCsPoppy2 v = CsPoppy2+  { csPoppy2Bits     = v+  , csPoppy2512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index+  , csPoppy2Layer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0+  , csPoppy2Layer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1+  , csPoppy2LayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)+  }+  where csPoppy2Cum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048+        gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else popCount1Range (indexN *           8)           8 v + DVS.last u+        genCum2048 u = let indexN = DVS.length u in+          if indexN .&. 0xffffffff == 0+            then 0+            else popCount1Range ((indexN - 1) *    32)          32 v + DVS.last u+        genLayer0 u = let indexN = DVS.length u in+          if indexN == 0+            then 0+            else popCount1Range (indexN * 0x100000000) 0x100000000 v + DVS.last u+        genLayer1 u = let indexN = DVS.length u in+          let cum = if indexN == 0 -- TODO Check boundary at 4G???+              then  0+              else  csPoppy2Cum2048 !!! fromIntegral indexN in+          let a = popCount1Range (indexN * 32 +  0) 8 v in+          let b = popCount1Range (indexN * 32 +  8) 8 v in+          let c = popCount1Range (indexN * 32 + 16) 8 v in+          (   ( cum       .&. 0x00000000ffffffff)+          .|. ((a .<. 32) .&. 0x000003ff00000000)+          .|. ((b .<. 42) .&. 0x000ffc0000000000)+          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)+        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          else Nothing++instance BitRead CsPoppy2 where+  bitRead = fmap makeCsPoppy2 . bitRead++instance Rank1 CsPoppy2 where+  rank1 (CsPoppy2 v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock+    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)+          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)+          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff+          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32+          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42+          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52+          q                       = (p `div` 512) `mod` 4 -- quarter+          rankLayer1  | q == 0    = rankLayer1A+                      | q == 1    = rankLayer1A + rankLayer1B+                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C+                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D+                      | otherwise = undefined+          rankPrior               = (rankLayer0 + rankLayer1) :: Count+          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Select1 CsPoppy2 where+  select1 (CsPoppy2 v i _ _ _) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = (i !!! q) :: Count+          wordAt = (i !!!)++sampleRange :: CsPoppy2 -> Count -> (Word64, Word64)+sampleRange (CsPoppy2 _ 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))

@@ -0,0 +1,122 @@+{-# LANGUAGE TypeFamilies   #-}++module HaskellWorks.Data.RankSelect.Poppy512+    ( Poppy512(..)+    , Rank1(..)+    , makePoppy512+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.AtIndex+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.Select0+import           HaskellWorks.Data.RankSelect.Base.Select1+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.BalancedParens.BalancedParens+import           HaskellWorks.Data.BalancedParens.CloseAt+import           HaskellWorks.Data.BalancedParens.Enclose+import           HaskellWorks.Data.BalancedParens.FindClose+import           HaskellWorks.Data.BalancedParens.FindOpen+import           HaskellWorks.Data.BalancedParens.FindCloseN+import           HaskellWorks.Data.BalancedParens.FindOpenN+import           HaskellWorks.Data.BalancedParens.NewCloseAt+import           HaskellWorks.Data.BalancedParens.OpenAt+import           HaskellWorks.Data.Vector.AsVector64+import           Prelude hiding (length)++data Poppy512 = Poppy512+  { poppy512Bits  :: DVS.Vector Word64+  , poppy512Index :: DVS.Vector Word64+  } deriving (Eq, Show)++instance AsVector64 Poppy512 where+  asVector64 = asVector64 . poppy512Bits+  {-# INLINE asVector64 #-}++makePoppy512 :: DVS.Vector Word64 -> Poppy512+makePoppy512 v = Poppy512+  { poppy512Bits  = v+  , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index+  }+  where gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v)) + DVS.last u++instance BitLength Poppy512 where+  bitLength v = length (poppy512Bits v) * bitLength (poppy512Bits v !!! 0)+  {-# INLINE bitLength #-}++instance TestBit Poppy512 where+  (.?.) = (.?.) . poppy512Bits+  {-# INLINE (.?.) #-}++instance BitRead Poppy512 where+  bitRead = fmap makePoppy512 . bitRead++instance Rank1 Poppy512 where+  rank1 (Poppy512 v i) p =+    (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)++instance Rank0 Poppy512 where+  rank0 (Poppy512 v i) p =+    p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)++instance Select1 Poppy512 where+  select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = (i !!! q) :: Count+          wordAt = (i !!!)++instance Select0 Poppy512 where+  select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = (fromIntegral q * 512 - (i !!! q)) :: Count+          wordAt o = fromIntegral o * 512 - (i !!! o)++instance OpenAt Poppy512 where+  openAt = openAt . poppy512Bits+  {-# INLINE openAt #-}++instance CloseAt Poppy512 where+  closeAt = closeAt . poppy512Bits+  {-# INLINE closeAt #-}++instance FindOpenN Poppy512 where+  findOpenN = findOpenN . poppy512Bits+  {-# INLINE findOpenN    #-}++instance FindCloseN Poppy512 where+  findCloseN = findCloseN . poppy512Bits+  {-# INLINE findCloseN #-}++instance FindOpen Poppy512 where+  findOpen = findOpen . poppy512Bits+  {-# INLINE findOpen #-}++instance FindClose Poppy512 where+  findClose = findClose . poppy512Bits+  {-# INLINE findClose #-}++instance NewCloseAt Poppy512 where+  newCloseAt = newCloseAt . poppy512Bits+  {-# INLINE newCloseAt #-}++instance Enclose Poppy512 where+  enclose = enclose . poppy512Bits+  {-# INLINE enclose #-}++instance BalancedParens Poppy512 where+  firstChild  = firstChild  . poppy512Bits+  nextSibling = nextSibling . poppy512Bits+  parent      = parent      . poppy512Bits+  {-# INLINE firstChild  #-}+  {-# INLINE nextSibling #-}+  {-# INLINE parent      #-}

@@ -0,0 +1,143 @@+module HaskellWorks.Data.RankSelect.Poppy512S+    ( Poppy512S(..)+    , Rank1(..)+    , makePoppy512S+    , sampleRange+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.AtIndex+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.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.Vector.AsVector64+import           Prelude hiding (length)++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)++instance AsVector64 Poppy512S where+  asVector64 = asVector64 . poppy512SBits+  {-# INLINE asVector64 #-}++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> 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 popCount1Range (indexN * 8) 8 v + DVS.last u+        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          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      #-}

@@ -1,13 +0,0 @@-module HaskellWorks.Data.Succinct.BalancedParens-  ( module X-  ) where--import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens as X-import HaskellWorks.Data.Succinct.BalancedParens.CloseAt        as X-import HaskellWorks.Data.Succinct.BalancedParens.Enclose        as X-import HaskellWorks.Data.Succinct.BalancedParens.FindClose      as X-import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN     as X-import HaskellWorks.Data.Succinct.BalancedParens.FindOpen       as X-import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN      as X-import HaskellWorks.Data.Succinct.BalancedParens.OpenAt         as X-import HaskellWorks.Data.Succinct.BalancedParens.Simple         as X

@@ -1,65 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.BalancedParens-  ( BalancedParens(..)-  , depth-  , subtreeSize-  ) where--import           Control.Monad-import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt--class (OpenAt v, CloseAt v, FindOpen v, FindClose v, Enclose v) => BalancedParens v where-  -- TODO Second argument should be Int-  firstChild  :: v -> Count -> Maybe Count-  nextSibling :: v -> Count -> Maybe Count-  parent      :: v -> Count -> Maybe Count-  firstChild  v p = if openAt v p && openAt v (p + 1)   then Just (p + 1) else Nothing-  nextSibling v p = if closeAt v p-    then Nothing-    else openAt v `mfilter` (findClose v p >>= (\q ->-      if p /= q-        then return (q + 1)-        else Nothing))-  parent      v p = enclose   v p >>= (\r -> if r >= 1 then return r      else Nothing)-  {-# INLINE firstChild   #-}-  {-# INLINE nextSibling  #-}-  {-# INLINE parent       #-}--depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count-depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p-{-# INLINE depth #-}--subtreeSize :: BalancedParens v => v -> Count -> Maybe Count-subtreeSize v p = (\q -> (q - p + 1) `quot` 2) <$> findClose v p-{-# INLINE subtreeSize #-}--instance BalancedParens [Bool]--instance BalancedParens (DVS.Vector Word8)--instance BalancedParens (DVS.Vector Word16)--instance BalancedParens (DVS.Vector Word32)--instance BalancedParens (DVS.Vector Word64)--instance BalancedParens Word8--instance BalancedParens Word16--instance BalancedParens Word32--instance BalancedParens Word64--instance BalancedParens (Naive Word64)

@@ -1,199 +0,0 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE ScopedTypeVariables   #-}--module HaskellWorks.Data.Succinct.BalancedParens.Broadword-  ( findCloseW64-  , ocCalc8-  , ocCalc64-  , showPadded-  , kkBitDiffPos-  , kkBitDiff-  , kkBitDiffSimple-  ) where--import qualified Data.Bits                        as DB-import           Data.Int-import           Data.Word-import           Debug.Trace-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.Broadword--traceW :: String -> Word64 -> Word64-traceW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ show w ++ ", " ++ show (fromIntegral w :: Int64)) w--findCloseW64 :: Word64 -> Word64-findCloseW64 x =                                                                         -- let !_ = traceW "x00" x   in-  let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1)                                   in -- let !_ = traceW "b00" b00 in-  let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333)      in -- let !_ = traceW "b01" b01 in-  let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f                               in -- let !_ = traceW "b02" b02 in-  let !b03 = (b02 * 0x0101010101010101) .<. 1                                         in -- let !_ = traceW "b03" b03 in-  let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03                        in -- let !_ = traceW "b04" b04 in-  let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                  in -- let !_ = traceW "u00" u00 in-  let !z00 =                         ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00              in -- let !_ = traceW "z00" z00 in-                                                                                         -- let !_ = trace "" False   in-  let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1))))  in -- let !_ = traceW "d10" d10 in-  let !b10 = b04 - d10                                                                in -- let !_ = traceW "b10" b10 in-  let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                  in -- let !_ = traceW "u10" u10 in-  let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10)             in -- let !_ = traceW "z10" z10 in-                                                                                         -- let !_ = trace "" False   in-  let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1))))  in -- let !_ = traceW "d20" d20 in-  let !b20 = b10 - d20                                                                in -- let !_ = traceW "b20" b20 in-  let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                  in -- let !_ = traceW "u20" u20 in-  let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20)             in -- let !_ = traceW "z20" z20 in-                                                                                         -- let !_ = trace "" False   in-  let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1))))  in -- let !_ = traceW "d30" d30 in-  let !b30 = b20 - d30                                                                in -- let !_ = traceW "b30" b30 in-  let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8                  in -- let !_ = traceW "u30" u30 in-  let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|.  l 8     ) .&. u30)             in -- let !_ = traceW "z30" z30 in--  let !p00 = lsb (z30 .>. 6 .&. l 8)                                                  in -- let !_ = traceW "p00" p00 in-  let !r00 = ((p00 + ((z30 .>. fromIntegral p00) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in -- let !_ = traceW "r00" r00 in-  r00-{-# INLINE findCloseW64 #-}---- µ0 :: Word64--- µ0 = 0x5555555555555555--µ1 :: Word64-µ1 = 0x3333333333333333--µ2 :: Word64-µ2 = 0x0F0F0F0F0F0F0F0F--µ3 :: Word64-µ3 = 0x00FF00FF00FF00FF--µ4 :: Word64-µ4 = 0x0000FFFF0000FFFF--µ5 :: Word64-µ5 = 0x00000000FFFFFFFF--ocCalc64 :: Word64 -> (Word64, Word64)-ocCalc64 x =-  let b0  =   x .&. 0x5555555555555555                            in let !_ = traceW "b0 " b0  in-  let b1  =  (x .&. 0xAAAAAAAAAAAAAAAA) .>. 1                     in let !_ = traceW "b1 " b1  in-  let ll  =  (b0 .^. b1) .&. b1                                   in let !_ = traceW "ll " ll  in-  let o1  =  (b0 .&. b1) .<. 1 .|. ll                             in let !_ = traceW "o1 " o1  in-  let c1  = ((b0 .|. b1) .^. 0x5555555555555555) .<. 1 .|. ll     in let !_ = traceW "c1 " c1  in--  let eo1 =    o1 .&. µ1                                          in let !_ = traceW "eo1" eo1 in-  let ec1 =  ((c1 .&. µ1) .<.  2) .>.  2                          in let !_ = traceW "ec1" ec1 in-  let o2  = (((o1 .&. µ1) .<.  2) .>.  2) + kBitDiffPos 8 eo1 ec1 in let !_ = traceW "o2 " o2  in-  let c2  =   (c1 .&. µ1)                 + kBitDiffPos 8 ec1 eo1 in let !_ = traceW "c2 " c2  in--  let eo2 =    o2 .&. µ2                                          in let !_ = traceW "eo2" eo2 in-  let ec2 =  ((c2 .&. µ2) .<.  4) .>.  4                          in let !_ = traceW "ec2" ec2 in-  let o3  = (((o2 .&. µ2) .<.  4) .>.  4) + kBitDiffPos 8 eo2 ec2 in let !_ = traceW "o3 " o3  in-  let c3  =   (c2 .&. µ2)                 + kBitDiffPos 8 ec2 eo2 in let !_ = traceW "c3 " c3  in--  let eo3 =    o3 .&. µ3                                          in let !_ = traceW "eo3" eo3 in-  let ec3 =  ((c3 .&. µ3) .<.  8) .>.  8                          in let !_ = traceW "ec3" ec3 in-  let o4  = (((o3 .&. µ3) .<.  8) .>.  8) + kBitDiffPos 8 eo3 ec3 in let !_ = traceW "o4 " o4  in-  let c4  =   (c3 .&. µ3)                 + kBitDiffPos 8 ec3 eo3 in let !_ = traceW "c4 " c4  in--  let eo4 =    o4 .&. µ4                                          in let !_ = traceW "eo4" eo4 in-  let ec4 =  ((c4 .&. µ4) .<. 16) .>. 16                          in let !_ = traceW "ec4" ec4 in-  let o5  = (((o4 .&. µ4) .<. 16) .>. 16) + kBitDiffPos 8 eo4 ec4 in let !_ = traceW "o5 " o5  in-  let c5  =   (c4 .&. µ4)                 + kBitDiffPos 8 ec4 eo4 in let !_ = traceW "c5 " c5  in--  let eo5 =    o5 .&. µ5                                          in let !_ = traceW "eo5" eo5 in-  let ec5 =  ((c5 .&. µ5) .<. 32) .>. 32                          in let !_ = traceW "ec5" ec5 in-  let o6  = (((o5 .&. µ5) .<. 32) .>. 32) + kBitDiffPos 8 eo5 ec5 in let !_ = traceW "o6 " o6  in-  let c6  =   (c5 .&. µ5)                 + kBitDiffPos 8 ec5 eo5 in let !_ = traceW "c6 " c6  in--  (o6, c6)---- µµ0 :: Word8--- µµ0 = 0x55--µµ1 :: Word8-µµ1 = 0x33--µµ2 :: Word8-µµ2 = 0x0F--hh :: Int -> Word8-hh 2   = 0xaa-hh 4   = 0x88-hh 8   = 0x80-hh 16  = 0x80-hh 32  = 0x80-hh 64  = 0x80-hh k   = error ("Invalid h k where k = " ++ show k)-{-# INLINE hh #-}--kkBitDiff :: Int -> Word8 -> Word8 -> Word8-kkBitDiff k x y = ((x .|. hh k) - (y .&. comp (hh k))) .^. ((x .^. comp y) .&. hh k)-{-# INLINE kkBitDiff #-}--kkBitDiffSimple :: Int -> Word8 -> Word8 -> Word8-kkBitDiffSimple k x y = ((x .|. hh k) - y) .^. hh k-{-# INLINE kkBitDiffSimple #-}--kkBitDiffPos :: Int -> Word8 -> Word8 -> Word8-kkBitDiffPos k x y = let d = kkBitDiff k x y in d .&. kkBitDiff k (d .>. fromIntegral (k - 1)) 1-{-# INLINE kkBitDiffPos #-}--showPadded :: Show a => Int -> a -> String-showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..]))--traceWW :: String -> Word8 -> Word8-traceWW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ showPadded 3 w ++ ", " ++ showPadded 3 (fromIntegral w :: Int8)) w--(.>+.) :: Word8 -> Int -> Word8-(.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n))---- import qualified Data.Vector.Storable as DVS--- import HaskellWorks.Data.Bits.FromBitTextByteString--- import Data.Word--- import HaskellWorks.Data.Succinct.BalancedParens.Broadword--ocCalc8 :: Word8 -> Word8 -> Word8-ocCalc8 p x =-  let b0  =   x .&. 0x55                                                            in let !_ = traceWW "b0 " b0  in-  let b1  =  (x .&. 0xAA) .>. 1                                                     in let !_ = traceWW "b1 " b1  in-  let ll  =  (b0 .^. b1) .&. b1                                                     in let !_ = traceWW "ll " ll  in-  let o1  =  (b0 .&. b1)           .<. 1 .|. ll                                     in let !_ = traceWW "o1 " o1  in-  let c1  = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll                                     in let !_ = traceWW "c1 " c1  in--  -- arithmetic operators come first, ordered in the standard way-  -- followed by shifts-  -- .&.-  -- .^.-  -- .|.-  let eo1 =   o1 .&.  µµ1                                                           in let !_ = traceWW "eo1" eo1 in-  let ec1 =  (c1 .&. (µµ1 .<.  2)) .>.  2                                           in let !_ = traceWW "ec1" ec1 in-  let o2  = ((o1 .&. (µµ1 .<.  2)) .>.  2) + kkBitDiffPos 4 eo1 ec1                 in let !_ = traceWW "o2 " o2  in -- <- Should this be 8 or 4?-  let !_ = traceWW "xxx" (kkBitDiffPos 4 ec1 eo1) in-  let !_ = traceWW "yyy" (c1 .&.  µµ1) in-  let c2  =  (c1 .&.  µµ1)                 + kkBitDiffPos 4 ec1 eo1                 in let !_ = traceWW "c2 " c2  in--  let eo2 =   o2 .&.  µµ2                                                           in let !_ = traceWW "eo2" eo2 in-  let ec2 =  (c2 .&. (µµ2 .<.  4)) .>.  4                                           in let !_ = traceWW "ec2" ec2 in-  let o3  = ((o2 .&. (µµ2 .<.  4)) .>.  4) + kkBitDiffPos 8 eo2 ec2                 in let !_ = traceWW "o3 " o3  in-  let c3  =  (c2 .&.  µµ2)                 + kkBitDiffPos 8 ec2 eo2                 in let !_ = traceWW "c3 " c3  in--  let nnn  =       ((c2 .>. 0) .&. 15)                                              in let !_ = traceWW "nnn" nnn in-  let qqq  =  (((c2 .>. 0) .&. 15) - p)                                             in let !_ = traceWW "qqq" qqq in-  let bb2  = ((((c2 .>. 0) .&. 15) - p) .>+. 7)                                     in let !_ = traceWW "bb2" bb2 in-  let mm2  = bb2 .&. 15                                                             in let !_ = traceWW "mm2" mm2 in-  let pa2  = p   - (c2 .&. mm2)                                                     in let !_ = traceWW "pa2" pa2 in-  let pb2  = pa2 + (o2 .&. mm2)                                                     in let !_ = traceWW "pb2" pb2 in-  let ss2  = 4 .&. bb2                                                              in let !_ = traceWW "ss2" ss2 in--  -- let nnn  =   ((c1 .>. fromIntegral ss2) .&. 3)                                    in let !_ = traceWW "nnn" nnn in-  -- let qqq  =  (((c1 .>. fromIntegral ss2) .&. 3) - pb2)                             in let !_ = traceWW "qqq" qqq in-  let bb1  = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7)                     in let !_ = traceWW "bb1" bb1 in-  let mm1  = bb1 .&. 3                                                              in let !_ = traceWW "mm1" mm1 in-  let pa1  = pa2 - (c1 .&. mm1)                                                     in let !_ = traceWW "pa1" pa1 in-  let pb1  = pa1 + (o1 .&. mm1)                                                     in let !_ = traceWW "pb1" pb1 in-  let ss1  = ss2 + (2  .&. bb1)                                                     in let !_ = traceWW "ss1" ss1 in--  let rrr  = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1)   in let !_ = traceWW "rrr" rrr in--  rrr

@@ -1,73 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.CloseAt-  ( CloseAt(..)-  ) where--import           Data.Vector.Storable             as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.Broadword-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Naive--closeAt' :: TestBit a => a -> Count -> Bool-closeAt' v c = not (v .?. toPosition (c - 1))-{-# INLINE closeAt' #-}--class CloseAt v where-  closeAt     :: v -> Count -> Bool--instance (BitLength a, TestBit a) => CloseAt (BitShown a) where-  closeAt = closeAt' . bitShown-  {-# INLINE closeAt #-}--instance CloseAt [Bool] where-  closeAt = closeAt'-  {-# INLINE closeAt #-}--instance CloseAt (DVS.Vector Word8) where-  closeAt = closeAt'-  {-# INLINE closeAt #-}---instance CloseAt (DVS.Vector Word16) where-  closeAt = closeAt'-  {-# INLINE closeAt #-}---instance CloseAt (DVS.Vector Word32) where-  closeAt = closeAt'-  {-# INLINE closeAt #-}---instance CloseAt (DVS.Vector Word64) where-  closeAt = closeAt'-  {-# INLINE closeAt #-}---instance CloseAt Word8 where-  closeAt = closeAt'-  {-# INLINE closeAt #-}--instance CloseAt Word16 where-  closeAt = closeAt'-  {-# INLINE closeAt #-}--instance CloseAt Word32 where-  closeAt = closeAt'-  {-# INLINE closeAt #-}--instance CloseAt Word64 where-  closeAt = closeAt'-  {-# INLINE closeAt     #-}--instance CloseAt (Naive Word64) where-  closeAt = closeAt'-  {-# INLINE closeAt #-}--instance CloseAt (Broadword Word64) where-  closeAt = closeAt . broadword-  {-# INLINE closeAt #-}

@@ -1,59 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.Enclose-  ( Enclose(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN--class Enclose v where-  enclose     :: v -> Count -> Maybe Count--instance (Enclose a) => Enclose (BitShown a) where-  enclose = enclose . bitShown-  {-# INLINE enclose #-}--instance Enclose [Bool] where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose (DVS.Vector Word8) where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose (DVS.Vector Word16) where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose (DVS.Vector Word32) where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose (DVS.Vector Word64) where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose Word8 where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose Word16 where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose Word32 where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose Word64 where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}--instance Enclose (Naive Word64) where-  enclose v = findOpenN v 1-  {-# INLINE enclose #-}

@@ -1,70 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.FindClose-  ( FindClose(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.Broadword-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.Broadword-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.FindCloseN--class FindClose v where-  findClose   :: v -> Count -> Maybe Count--instance (FindClose a) => FindClose (BitShown a) where-  findClose = findClose . bitShown-  {-# INLINE findClose #-}--instance FindClose [Bool] where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose (DVS.Vector Word8) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose (DVS.Vector Word16) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose (DVS.Vector Word32) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose (DVS.Vector Word64) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose Word8 where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose Word16 where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose Word32 where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose Word64 where-  findClose = findClose . Broadword-  {-# INLINE findClose #-}--instance FindClose (Naive Word64) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindClose (Broadword Word64) where-  findClose (Broadword w) p = let x = w .>. (p - 1) in-    case negate (x .&. 1) .&. findCloseW64 x of-      127 -> Nothing-      r   -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r'-  {-# INLINE findClose #-}

@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-  ( FindCloseN(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt--class FindCloseN v where-  findCloseN :: v -> Count -> Count -> Maybe Count--findClose' :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count-findClose' v c p = if 0 < p && p <= bitLength v-  then if v `closeAt` p-    then if c <= 1-      then Just p-      else findClose' v (c - 1) (p + 1)-    else findClose' v (c + 1) (p + 1)-  else Nothing-{-# INLINE findClose' #-}--instance (CloseAt a, TestBit a, BitLength a) => FindCloseN (BitShown a) where-  findCloseN = findClose' . bitShown-  {-# INLINE findCloseN #-}--instance FindCloseN [Bool] where-  findCloseN = findClose'-  {-# INLINE findCloseN  #-}--instance FindCloseN (DVS.Vector Word8) where-  findCloseN = findClose'-  {-# INLINE findCloseN  #-}--instance FindCloseN (DVS.Vector Word16) where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}--instance FindCloseN (DVS.Vector Word32) where-  findCloseN = findClose'-  {-# INLINE findCloseN  #-}--instance FindCloseN (DVS.Vector Word64) where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}--instance FindCloseN Word8 where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}--instance FindCloseN Word16 where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}--instance FindCloseN Word32 where-  findCloseN = findClose'-  {-# INLINE findCloseN  #-}--instance FindCloseN Word64 where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}--instance FindCloseN (Naive Word64) where-  findCloseN = findClose'-  {-# INLINE findCloseN #-}

@@ -1,60 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.FindOpen-  ( FindOpen(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt--class FindOpen v where-  findOpen    :: v -> Count -> Maybe Count--instance (FindOpen a) => FindOpen (BitShown a) where-  findOpen = findOpen . bitShown-  {-# INLINE findOpen #-}--instance FindOpen [Bool] where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen (DVS.Vector Word8) where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen (DVS.Vector Word16) where-  findOpen v p = if v `openAt` p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen (DVS.Vector Word32) where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen (DVS.Vector Word64) where-  findOpen v p = if v `openAt` p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen Word8 where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen Word16 where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen Word32 where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen Word64 where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}--instance FindOpen (Naive Word64) where-  findOpen v p = if v `openAt`  p then Just p else findOpenN  v 0 (p - 1)-  {-# INLINE findOpen #-}

@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-  ( FindOpenN(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt--class FindOpenN v where-  findOpenN :: v -> Count -> Count -> Maybe Count--findOpen' :: (BitLength a, OpenAt a, TestBit a) => a -> Count -> Count -> Maybe Count-findOpen' v c p = if 0 < p && p <= bitLength v-  then if v `openAt` p-    then if c == 0-      then Just p-      else findOpen' v (c - 1) (p - 1)-    else findOpen' v (c + 1) (p - 1)-  else Nothing-{-# INLINE findOpen' #-}--instance (BitLength a, OpenAt a, TestBit a) => FindOpenN (BitShown a) where-  findOpenN  = findOpen' . bitShown-  {-# INLINE findOpenN #-}--instance FindOpenN [Bool] where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN (DVS.Vector Word8) where-  findOpenN = findOpen'-  {-# INLINE findOpenN   #-}--instance FindOpenN (DVS.Vector Word16) where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN (DVS.Vector Word32) where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN (DVS.Vector Word64) where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN Word8 where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN Word16 where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN Word32 where-  findOpenN = findOpen'-  {-# INLINE findOpenN   #-}--instance FindOpenN Word64 where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}--instance FindOpenN (Naive Word64) where-  findOpenN = findOpen'-  {-# INLINE findOpenN #-}

@@ -1,60 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-  ( NewCloseAt(..)-  , newCloseAt'-  ) where--import qualified Data.Vector.Storable             as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Positioning--class NewCloseAt v where-  newCloseAt     :: v -> Count -> Bool--newCloseAt' :: TestBit a => a -> Count -> Bool-newCloseAt' v c = not (v .?. toPosition c)-{-# INLINE newCloseAt' #-}--instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where-  newCloseAt = newCloseAt' . bitShown-  {-# INLINE newCloseAt #-}--instance NewCloseAt [Bool] where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt (DVS.Vector Word8) where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt (DVS.Vector Word16) where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt (DVS.Vector Word32) where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt (DVS.Vector Word64) where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt Word8 where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt Word16 where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt Word32 where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}--instance NewCloseAt Word64 where-  newCloseAt = newCloseAt'-  {-# INLINE newCloseAt #-}

@@ -1,59 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt-  ( NewOpenAt(..)-  ) where--import qualified Data.Vector.Storable             as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Positioning--class NewOpenAt v where-  newOpenAt      :: v -> Count -> Bool--newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool-newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c)-{-# INLINE newOpenAt' #-}--instance (BitLength a, TestBit a) => NewOpenAt (BitShown a) where-  newOpenAt = newOpenAt' . bitShown-  {-# INLINE newOpenAt #-}--instance NewOpenAt [Bool] where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt (DVS.Vector Word8) where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt (DVS.Vector Word16) where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt (DVS.Vector Word32) where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt (DVS.Vector Word64) where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt Word8 where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt Word16 where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt Word32 where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}--instance NewOpenAt Word64 where-  newOpenAt = newOpenAt'-  {-# INLINE newOpenAt #-}

@@ -1,69 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.BalancedParens.OpenAt-  ( OpenAt(..)-  ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.Broadword-import           HaskellWorks.Data.Naive-import           HaskellWorks.Data.Positioning--class OpenAt v where-  openAt      :: v -> Count -> Bool--openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool-openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1))-{-# INLINE openAt' #-}--instance (BitLength a, TestBit a) => OpenAt (BitShown a) where-  openAt = openAt' . bitShown-  {-# INLINE openAt #-}--instance OpenAt [Bool] where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (DVS.Vector Word8) where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (DVS.Vector Word16) where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (DVS.Vector Word32) where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (DVS.Vector Word64) where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt Word8 where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt Word16 where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt Word32 where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt Word64 where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (Naive Word64) where-  openAt = openAt'-  {-# INLINE openAt #-}--instance OpenAt (Broadword Word64) where-  openAt = openAt . broadword-  {-# INLINE openAt #-}

@@ -1,239 +0,0 @@-{-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE FlexibleContexts   #-}-{-# LANGUAGE FlexibleInstances  #-}-{-# LANGUAGE InstanceSigs       #-}-{-# LANGUAGE TypeFamilies       #-}--module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax-  ( RangeMinMax(..)-  , mkRangeMinMax-  ) where--import           Data.Int-import qualified Data.Vector                                                    as DV-import qualified Data.Vector.Storable                                           as DVS-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.AllExcess.AllExcess1-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Excess.MinMaxExcess1-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.Succinct.BalancedParens.BalancedParens-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt-import           HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-import           HaskellWorks.Data.Vector.AsVector64-import           Prelude hiding (length)--data RangeMinMax a = RangeMinMax-  { rangeMinMaxBP       :: !a-  , rangeMinMaxL0Min    :: !(DVS.Vector Int8)-  , rangeMinMaxL0Max    :: !(DVS.Vector Int8)-  , rangeMinMaxL0Excess :: !(DVS.Vector Int8)-  , rangeMinMaxL1Min    :: !(DVS.Vector Int16)-  , rangeMinMaxL1Max    :: !(DVS.Vector Int16)-  , rangeMinMaxL1Excess :: !(DVS.Vector Int16)-  , rangeMinMaxL2Min    :: !(DVS.Vector Int16)-  , rangeMinMaxL2Max    :: !(DVS.Vector Int16)-  , rangeMinMaxL2Excess :: !(DVS.Vector Int16)-  }--factorL0 :: Integral a => a-factorL0 = 1-{-# INLINE factorL0 #-}--factorL1 :: Integral a => a-factorL1 = 32-{-# INLINE factorL1 #-}--factorL2 :: Integral a => a-factorL2 = 32-{-# INLINE factorL2 #-}--pageSizeL0 :: Integral a => a-pageSizeL0 = factorL0-{-# INLINE pageSizeL0 #-}--pageSizeL1 :: Integral a => a-pageSizeL1 = pageSizeL0 * factorL1-{-# INLINE pageSizeL1 #-}--pageSizeL2 :: Integral a => a-pageSizeL2 = pageSizeL1 * factorL2-{-# INLINE pageSizeL2 #-}--mkRangeMinMax :: AsVector64 a => a -> RangeMinMax a-mkRangeMinMax bp = RangeMinMax-  { rangeMinMaxBP       = bp-  , rangeMinMaxL0Min    = rmmL0Min-  , rangeMinMaxL0Max    = rmmL0Max-  , rangeMinMaxL0Excess = dvsReword rmmL0Excess-  , rangeMinMaxL1Min    = rmmL1Min-  , rangeMinMaxL1Max    = rmmL1Max-  , rangeMinMaxL1Excess = dvsReword rmmL1Excess-  , rangeMinMaxL2Min    = rmmL2Min-  , rangeMinMaxL2Max    = rmmL2Max-  , rangeMinMaxL2Excess = rmmL2Excess-  }-  where bpv           = asVector64 bp-        lenBP         = fromIntegral (length bpv) :: Int-        lenL0         = lenBP-        lenL1         = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int-        lenL2         = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int-        allMinMaxL0   = dvConstructNI  lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i))-        allMinMaxL1   = dvConstructNI  lenL1 (\i -> minMaxExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv))-        allMinMaxL2   = dvConstructNI  lenL2 (\i -> minMaxExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv))-        rmmL0Excess   = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16-        rmmL1Excess   = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16-        rmmL2Excess   = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16-        rmmL0Min      = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE)-        rmmL1Min      = dvsConstructNI lenL1 (\i -> let (minE, _, _) = allMinMaxL1 DV.! i in fromIntegral minE)-        rmmL2Min      = dvsConstructNI lenL2 (\i -> let (minE, _, _) = allMinMaxL2 DV.! i in fromIntegral minE)-        rmmL0Max      = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE)-        rmmL1Max      = dvsConstructNI lenL1 (\i -> let (_, _, maxE) = allMinMaxL1 DV.! i in fromIntegral maxE)-        rmmL2Max      = dvsConstructNI lenL2 (\i -> let (_, _, maxE) = allMinMaxL2 DV.! i in fromIntegral maxE)--dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a-dropTake n o = DVS.take o . DVS.drop n-{-# INLINE dropTake #-}--dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b-dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))-{-# INLINE dvsReword #-}--pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-pageFill n s = dropTakeFill (n * s) s-{-# INLINE pageFill #-}--dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-dropTakeFill n o a v =  let r = DVS.take o (DVS.drop n v) in-                        let len = DVS.length r in-                        if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)]-{-# INLINE dropTakeFill #-}--dvConstructNI :: Int -> (Int -> a) -> DV.Vector a-dvConstructNI n g = DV.constructN n (g . DV.length)-{-# INLINE dvConstructNI #-}--dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a-dvsConstructNI n g = DVS.constructN n (g . DVS.length)-{-# INLINE dvsConstructNI #-}--data FindState = FindBP-  | FindL0 | FindFromL0-  | FindL1 | FindFromL1-  | FindL2 | FindFromL2--rmm2FindClose  :: (BitLength a, NewCloseAt a) => RangeMinMax a -> Int -> Count -> FindState -> Maybe Count-rmm2FindClose v s p FindBP = if v `newCloseAt` p-  then if s <= 1-    then Just p-    else rmm2FindClose v (s - 1) (p + 1) FindFromL0-  else rmm2FindClose v (s + 1) (p + 1) FindFromL0-rmm2FindClose v s p FindL0 =-  let i = p `div` 64 in-  let mins = rangeMinMaxL0Min v in-  let minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindBP-    else if v `newCloseAt` p && s <= 1-      then Just p-      else  let excesses  = rangeMinMaxL0Excess v in-            let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-            rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0-rmm2FindClose v s p FindL1 =-  let !i = p `div` (64 * pageSizeL1) in-  let !mins = rangeMinMaxL1Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL0-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMaxL1Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1-      else Nothing-rmm2FindClose v s p FindL2 =-  let !i = p `div` (64 * pageSizeL2) in-  let !mins = rangeMinMaxL2Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL1-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMaxL2Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2-      else Nothing-rmm2FindClose v s p FindFromL0-  | p `mod` 64 == 0             = rmm2FindClose v s p FindFromL1-  | 0 <= p && p < bitLength v   = rmm2FindClose v s p FindBP-  | otherwise                   = Nothing-rmm2FindClose v s p FindFromL1-  | p `mod` (64 * pageSizeL1) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL0-  | otherwise                       = Nothing-rmm2FindClose v s p FindFromL2-  | p `mod` (64 * pageSizeL2) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL2 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL1-  | otherwise                       = Nothing-{-# INLINE rmm2FindClose #-}--instance TestBit a => TestBit (RangeMinMax a) where-  (.?.) = (.?.) . rangeMinMaxBP-  {-# INLINE (.?.) #-}--instance Rank1 a => Rank1 (RangeMinMax a) where-  rank1 = rank1 . rangeMinMaxBP-  {-# INLINE rank1 #-}--instance Rank0 a => Rank0 (RangeMinMax a) where-  rank0 = rank0 . rangeMinMaxBP-  {-# INLINE rank0 #-}--instance BitLength a => BitLength (RangeMinMax a) where-  bitLength = bitLength . rangeMinMaxBP-  {-# INLINE bitLength #-}--instance OpenAt a => OpenAt (RangeMinMax a) where-  openAt = openAt . rangeMinMaxBP-  {-# INLINE openAt #-}--instance CloseAt a => CloseAt (RangeMinMax a) where-  closeAt = closeAt . rangeMinMaxBP-  {-# INLINE closeAt #-}--instance NewCloseAt a => NewCloseAt (RangeMinMax a) where-  newCloseAt = newCloseAt . rangeMinMaxBP-  {-# INLINE newCloseAt #-}--instance FindOpenN a => FindOpenN (RangeMinMax a) where-  findOpenN = findOpenN . rangeMinMaxBP-  {-# INLINE findOpenN #-}--instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMinMax a) where-  findCloseN v s p  = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0-  {-# INLINE findCloseN  #-}--instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMinMax a) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindOpen (RangeMinMax a) where-  findOpen = undefined-  {-# INLINE findOpen #-}--instance Enclose (RangeMinMax a) where-  enclose = undefined-  {-# INLINE enclose #-}--instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax a)

@@ -1,322 +0,0 @@-{-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE FlexibleContexts   #-}-{-# LANGUAGE FlexibleInstances  #-}-{-# LANGUAGE InstanceSigs       #-}-{-# LANGUAGE TypeFamilies       #-}--module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2-  ( RangeMinMax2(..)-  , mkRangeMinMax2-  , genMin-  , genMax-  ) where--import           Data.Int-import qualified Data.Vector                                                    as DV-import qualified Data.Vector.Storable                                           as DVS--- import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.AllExcess.AllExcess1-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Excess.MinMaxExcess1-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank0-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.Succinct.BalancedParens.BalancedParens-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt-import           HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-import           HaskellWorks.Data.Vector.AsVector64-import           Prelude hiding (length)--data RangeMinMax2 a = RangeMinMax2-  { rangeMinMax2BP       :: !a-  , rangeMinMax2L0Min    :: !(DVS.Vector Int8)-  , rangeMinMax2L0Max    :: !(DVS.Vector Int8)-  , rangeMinMax2L0Excess :: !(DVS.Vector Int8)-  , rangeMinMax2L1Min    :: !(DVS.Vector Int16)-  , rangeMinMax2L1Max    :: !(DVS.Vector Int16)-  , rangeMinMax2L1Excess :: !(DVS.Vector Int16)-  , rangeMinMax2L2Min    :: !(DVS.Vector Int16)-  , rangeMinMax2L2Max    :: !(DVS.Vector Int16)-  , rangeMinMax2L2Excess :: !(DVS.Vector Int16)-  , rangeMinMax2L3Min    :: !(DVS.Vector Int16)-  , rangeMinMax2L3Max    :: !(DVS.Vector Int16)-  , rangeMinMax2L3Excess :: !(DVS.Vector Int16)-  , rangeMinMax2L4Min    :: !(DVS.Vector Int16)-  , rangeMinMax2L4Max    :: !(DVS.Vector Int16)-  , rangeMinMax2L4Excess :: !(DVS.Vector Int16)-  }--factorL0 :: Integral a => a-factorL0 = 1-{-# INLINE factorL0 #-}--factorL1 :: Integral a => a-factorL1 = 32-{-# INLINE factorL1 #-}--factorL2 :: Integral a => a-factorL2 = 32-{-# INLINE factorL2 #-}--factorL3 :: Integral a => a-factorL3 = 32-{-# INLINE factorL3 #-}--factorL4 :: Integral a => a-factorL4 = 32-{-# INLINE factorL4 #-}--pageSizeL0 :: Integral a => a-pageSizeL0 = factorL0-{-# INLINE pageSizeL0 #-}--pageSizeL1 :: Integral a => a-pageSizeL1 = pageSizeL0 * factorL1-{-# INLINE pageSizeL1 #-}--pageSizeL2 :: Integral a => a-pageSizeL2 = pageSizeL1 * factorL2-{-# INLINE pageSizeL2 #-}--pageSizeL3 :: Integral a => a-pageSizeL3 = pageSizeL2 * factorL3-{-# INLINE pageSizeL3 #-}--pageSizeL4 :: Integral a => a-pageSizeL4 = pageSizeL3 * factorL4-{-# INLINE pageSizeL4 #-}--mkRangeMinMax2 :: AsVector64 a => a -> RangeMinMax2 a-mkRangeMinMax2 bp = RangeMinMax2-  { rangeMinMax2BP       = bp-  , rangeMinMax2L0Min    = dvsReword rmmL0Min-  , rangeMinMax2L0Max    = dvsReword rmmL0Max-  , rangeMinMax2L0Excess = dvsReword rmmL0Excess-  , rangeMinMax2L1Min    = rmmL1Min-  , rangeMinMax2L1Max    = rmmL1Max-  , rangeMinMax2L1Excess = rmmL1Excess-  , rangeMinMax2L2Min    = rmmL2Min-  , rangeMinMax2L2Max    = rmmL2Max-  , rangeMinMax2L2Excess = rmmL2Excess-  , rangeMinMax2L3Min    = rmmL3Min-  , rangeMinMax2L3Max    = rmmL3Max-  , rangeMinMax2L3Excess = rmmL3Excess-  , rangeMinMax2L4Min    = rmmL4Min-  , rangeMinMax2L4Max    = rmmL4Max-  , rangeMinMax2L4Excess = rmmL4Excess-  }-  where bpv           = asVector64 bp-        lenBP         = fromIntegral (length bpv) :: Int-        lenL0         = lenBP-        lenL1         = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int-        lenL2         = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int-        lenL3         = (DVS.length rmmL0Min `div` pageSizeL3) + 1 :: Int-        lenL4         = (DVS.length rmmL0Min `div` pageSizeL4) + 1 :: Int-        allMinMaxL0   = dvConstructNI  lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i))-        rmmL0Excess   = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16-        rmmL1Excess   = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16-        rmmL2Excess   = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16-        rmmL3Excess   = dvsConstructNI lenL3 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL3 (-64) bpv))) :: DVS.Vector Int16-        rmmL4Excess   = dvsConstructNI lenL4 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL4 (-64) bpv))) :: DVS.Vector Int16-        rmmL0Min      = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16-        rmmL1Min      = dvsConstructNI lenL1 (\i -> genMin 0 (pageFill i factorL1 0 rmmL0Min) (pageFill i factorL1 0 rmmL0Excess))-        rmmL2Min      = dvsConstructNI lenL2 (\i -> genMin 0 (pageFill i factorL2 0 rmmL1Min) (pageFill i factorL2 0 rmmL1Excess))-        rmmL3Min      = dvsConstructNI lenL3 (\i -> genMin 0 (pageFill i factorL3 0 rmmL2Min) (pageFill i factorL3 0 rmmL2Excess))-        rmmL4Min      = dvsConstructNI lenL4 (\i -> genMin 0 (pageFill i factorL4 0 rmmL3Min) (pageFill i factorL4 0 rmmL3Excess))-        rmmL0Max      = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE) :: DVS.Vector Int16-        rmmL1Max      = dvsConstructNI lenL1 (\i -> genMax 0 (pageFill i factorL1 0 rmmL0Max) (pageFill i factorL1 0 rmmL0Excess))-        rmmL2Max      = dvsConstructNI lenL2 (\i -> genMax 0 (pageFill i factorL2 0 rmmL1Max) (pageFill i factorL2 0 rmmL1Excess))-        rmmL3Max      = dvsConstructNI lenL3 (\i -> genMax 0 (pageFill i factorL3 0 rmmL2Max) (pageFill i factorL3 0 rmmL2Excess))-        rmmL4Max      = dvsConstructNI lenL4 (\i -> genMax 0 (pageFill i factorL4 0 rmmL3Max) (pageFill i factorL4 0 rmmL3Excess))--genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a-genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses)-  then genMin (dvsLastOrZero mins `min` (mL + dvsLastOrZero excesses)) (DVS.init mins) (DVS.init excesses)-  else mL--genMax :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a-genMax mL maxs excesses = if not (DVS.null maxs) || not (DVS.null excesses)-  then genMax (dvsLastOrZero maxs `max` (mL + dvsLastOrZero excesses)) (DVS.init maxs) (DVS.init excesses)-  else mL--pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-pageFill n s = dropTakeFill (n * s) s-{-# INLINE pageFill #-}--dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a-dropTakeFill n s a v =  let r = DVS.take s (DVS.drop n v) in-                        let rLen = DVS.length r in-                        if rLen == s then r else DVS.concat [r, DVS.replicate (s - rLen) a]-{-# INLINE dropTakeFill #-}--dvConstructNI :: Int -> (Int -> a) -> DV.Vector a-dvConstructNI n g = DV.constructN n (g . DV.length)-{-# INLINE dvConstructNI #-}--dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a-dvsConstructNI n g = DVS.constructN n (g . DVS.length)-{-# INLINE dvsConstructNI #-}--dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b-dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i))-{-# INLINE dvsReword #-}--dvsLastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a-dvsLastOrZero v = if not (DVS.null v) then DVS.last v else 0-{-# INLINE dvsLastOrZero #-}--data FindState = FindBP-  | FindL0 | FindFromL0-  | FindL1 | FindFromL1-  | FindL2 | FindFromL2-  | FindL3 | FindFromL3-  | FindL4 | FindFromL4--rmm2FindClose  :: (BitLength a, NewCloseAt a) => RangeMinMax2 a -> Int -> Count -> FindState -> Maybe Count-rmm2FindClose v s p FindBP = if v `newCloseAt` p-  then if s <= 1-    then Just p-    else rmm2FindClose v (s - 1) (p + 1) FindFromL0-  else rmm2FindClose v (s + 1) (p + 1) FindFromL0-rmm2FindClose v s p FindL0 =-  let i = p `div` 64 in-  let mins = rangeMinMax2L0Min v in-  let minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindBP-    else if v `newCloseAt` p && s <= 1-      then Just p-      else  let excesses  = rangeMinMax2L0Excess v in-            let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-            rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0-rmm2FindClose v s p FindL1 =-  let !i = p `div` (64 * pageSizeL1) in-  let !mins = rangeMinMax2L1Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL0-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMax2L1Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1-      else Nothing-rmm2FindClose v s p FindL2 =-  let !i = p `div` (64 * pageSizeL2) in-  let !mins = rangeMinMax2L2Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL1-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMax2L2Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2-      else Nothing-rmm2FindClose v s p FindL3 =-  let !i = p `div` (64 * pageSizeL3) in-  let !mins = rangeMinMax2L3Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL2-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMax2L3Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3-        else Nothing-rmm2FindClose v s p FindL4 =-  let !i = p `div` (64 * pageSizeL4) in-  let !mins = rangeMinMax2L4Min v in-  let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in-  if fromIntegral s + minE <= 0-    then rmm2FindClose v s p FindL3-    else if 0 <= p && p < bitLength v-      then if v `newCloseAt` p && s <= 1-        then Just p-        else  let excesses  = rangeMinMax2L4Excess v in-              let excess    = fromIntegral (excesses !!! fromIntegral i)  :: Int in-              rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4-        else Nothing-rmm2FindClose v s p FindFromL0-  | p `mod` 64 == 0             = rmm2FindClose v s p FindFromL1-  | 0 <= p && p < bitLength v   = rmm2FindClose v s p FindBP-  | otherwise                   = Nothing-rmm2FindClose v s p FindFromL1-  | p `mod` (64 * pageSizeL1) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL0-  | otherwise                       = Nothing-rmm2FindClose v s p FindFromL2-  | p `mod` (64 * pageSizeL2) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL3 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL1-  | otherwise                       = Nothing-rmm2FindClose v s p FindFromL3-  | p `mod` (64 * pageSizeL3) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL4 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL2-  | otherwise                       = Nothing-rmm2FindClose v s p FindFromL4-  | p `mod` (64 * pageSizeL4) == 0  = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL4 else Nothing-  | 0 <= p && p < bitLength v       = rmm2FindClose v s p FindL3-  | otherwise                       = Nothing-{-# INLINE rmm2FindClose #-}--instance TestBit a => TestBit (RangeMinMax2 a) where-  (.?.) = (.?.) . rangeMinMax2BP-  {-# INLINE (.?.) #-}--instance Rank1 a => Rank1 (RangeMinMax2 a) where-  rank1 = rank1 . rangeMinMax2BP-  {-# INLINE rank1 #-}--instance Rank0 a => Rank0 (RangeMinMax2 a) where-  rank0 = rank0 . rangeMinMax2BP-  {-# INLINE rank0 #-}--instance BitLength a => BitLength (RangeMinMax2 a) where-  bitLength = bitLength . rangeMinMax2BP-  {-# INLINE bitLength #-}--instance OpenAt a => OpenAt (RangeMinMax2 a) where-  openAt = openAt . rangeMinMax2BP-  {-# INLINE openAt #-}--instance CloseAt a => CloseAt (RangeMinMax2 a) where-  closeAt = closeAt . rangeMinMax2BP-  {-# INLINE closeAt #-}--instance NewCloseAt a => NewCloseAt (RangeMinMax2 a) where-  newCloseAt = newCloseAt . rangeMinMax2BP-  {-# INLINE newCloseAt #-}--instance FindOpenN a => FindOpenN (RangeMinMax2 a) where-  findOpenN = findOpenN . rangeMinMax2BP-  {-# INLINE findOpenN #-}--instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMinMax2 a) where-  findCloseN v s p  = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0-  {-# INLINE findCloseN  #-}--instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMinMax2 a) where-  findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1)-  {-# INLINE findClose #-}--instance FindOpen (RangeMinMax2 a) where-  findOpen = undefined-  {-# INLINE findOpen #-}--instance Enclose (RangeMinMax2 a) where-  enclose = undefined-  {-# INLINE enclose #-}--instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax2 a)

@@ -1,32 +0,0 @@-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module HaskellWorks.Data.Succinct.BalancedParens.Simple-  ( SimpleBalancedParens(..)-  ) where--import           Control.Monad-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Bits.BitWise-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.Succinct.BalancedParens.BalancedParens-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt-import           Prelude                                                    as P--newtype SimpleBalancedParens a = SimpleBalancedParens a-  deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit)--instance Functor SimpleBalancedParens where-  fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)-  {-# INLINABLE fmap   #-}--instance BitShow a => Show (SimpleBalancedParens a) where-  show = bitShow

@@ -1,64 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.EliasFano64-  ( EliasFano64(..)-  , FromEliasFano64(..)-  , ToEliasFano64(..)-  ) where--import qualified Data.Vector.Storable                 as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-import           HaskellWorks.Data.Bits.BitWise-import           HaskellWorks.Data.Bits.Log2-import           HaskellWorks.Data.Bits.PackedVector  as PV-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.EliasFano64.Internal-import           HaskellWorks.Data.Take-import           Safe-import           Prelude hiding (length, take)--data EliasFano64 = EliasFano64-  { hi      :: DVS.Vector Word64-  , lo      :: PackedVector64-  , loBits  :: Int-  , count   :: Count-  } deriving (Eq, Show)--class FromEliasFano64 a where-  fromEliasFano64 :: EliasFano64 -> a--class ToEliasFano64 a where-  toEliasFano64 :: a -> EliasFano64--instance ToEliasFano64 [Word64] where-  toEliasFano64 ws = case lastMay ws of-    Just end' -> EliasFano64-      { hi      = DVS.fromList (packToWord64 (packToWord32 (packToWord16 (packToWord8 (mkHiBits loBits' ws)))))-      , lo      = PV.fromList loBits' ws-      , loBits  = fromIntegral loBits'-      , count   = length'-      }-      where length' = length ws-            loBits' = fromIntegral (log2 (end' `div` length')) :: Count-    Nothing -> EliasFano64-      { hi      = DVS.empty-      , lo      = PV.empty-      , loBits  = 0-      , count   = 0-      }--instance FromEliasFano64 [Word64] where-  fromEliasFano64 ef = gen `fmap` take (count ef) [0 ..]-    where gen :: Int -> Word64-          gen i = let pos             = (loBits ef * i)                                         in-                  let (index, offset) = pos `quotRem` 64                                        in-                  let loValue         = (lo ef !!! fromIntegral index) .>. fromIntegral offset  in-                  let hiValue         = (lo ef !!! fromIntegral index) .>. fromIntegral offset  in-                  loValue + hiValue---- instance AtIndex EliasFano64 where---   (!!!)   v i = v !! fromIntegral i---   atIndex v i = v !! fromIntegral i---   {-# INLINE (!!!)   #-}---   {-# INLINE atIndex #-}

@@ -1,53 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.Succinct.EliasFano64.Internal-  ( mkHiBits-  , packToWord8-  , packToWord16-  , packToWord32-  , packToWord64-  ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.Widen--mkHiBits :: Count -> [Word64] -> [Bool]-mkHiBits = mkHiBits' 0--mkHiBits' :: Word64 -> Count -> [Word64] -> [Bool]-mkHiBits' _ _ [] = []-mkHiBits' oldHi loBitsSize wws@(w:ws) = case w .>. loBitsSize of-  newHi | oldHi <  newHi  -> False:mkHiBits' (oldHi + 1)  loBitsSize wws-  newHi | oldHi == newHi  -> True :mkHiBits'  oldHi       loBitsSize ws-  _                       -> error "Values must be non-decreasing"--packToWord8 :: [Bool] -> [Word8]-packToWord8 (a:b:c:d:e:f:g:h:xs) =-  (   (if a then 0x01 else 0x00)-  .|. (if b then 0x02 else 0x00)-  .|. (if c then 0x04 else 0x00)-  .|. (if d then 0x08 else 0x00)-  .|. (if e then 0x10 else 0x00)-  .|. (if f then 0x20 else 0x00)-  .|. (if g then 0x40 else 0x00)-  .|. (if h then 0x80 else 0x00)-  ) : packToWord8 xs-packToWord8 [] = []-packToWord8 xs = packToWord8 (take 8 (xs ++ [False]))--packToWord16 :: [Word8] -> [Word16]-packToWord16 (a:b:xs) = (widen16 a .|. (widen16 b .<.  8)):packToWord16 xs-packToWord16 (a  :xs) =  widen16 a                        :packToWord16 xs-packToWord16 []       = []--packToWord32 :: [Word16] -> [Word32]-packToWord32 (a:b:xs) = (widen32 a .|. (widen32 b .<. 16)):packToWord32 xs-packToWord32 (a  :xs) =  widen32 a                        :packToWord32 xs-packToWord32 []       = []--packToWord64 :: [Word32] -> [Word64]-packToWord64 (a:b:xs) = (widen64 a .|. (widen64 b .<. 32)):packToWord64 xs-packToWord64 (a  :xs) =  widen64 a                        :packToWord64 xs-packToWord64 []       = []

@@ -1,14 +0,0 @@-module HaskellWorks.Data.Succinct.NearestNeighbour-  ( bitPred-  , bitSucc-  ) where--import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.RankSelect.Base.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select1--bitPred :: (Rank1 v, Select1 v) => v -> Count -> Count-bitPred v p = select1 v (rank1 v p - 1)--bitSucc :: (Rank1 v, Select1 v) => v -> Count -> Count-bitSucc v p = select1 v (rank1 v p + 1)

@@ -1,120 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy-    ( CsPoppy(..)-    , Rank1(..)-    , makeCsPoppy-    , sampleRange-    ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-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.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select1-import           HaskellWorks.Data.Search-import           HaskellWorks.Data.Vector.AsVector64--data CsPoppy = CsPoppy-  { csPoppyBits     :: DVS.Vector Word64-  , csPoppy512Index :: DVS.Vector Word64-  , csPoppyLayer0   :: DVS.Vector Word64-  , csPoppyLayer1   :: DVS.Vector Word64-  , csPoppyLayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit-  } deriving (Eq, Show)--instance AsVector64 CsPoppy where-  asVector64 = asVector64 . csPoppyBits-  {-# INLINE asVector64 #-}--popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count-popCount1Range start len = popCount1 . DVS.take len . DVS.drop start--makeCsPoppy :: DVS.Vector Word64 -> CsPoppy-makeCsPoppy v = CsPoppy-  { csPoppyBits     = v-  , csPoppy512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index-  , csPoppyLayer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0-  , csPoppyLayer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1-  , csPoppyLayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)-  }-  where csPoppyCum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048-        gen512Index u = let indexN = DVS.length u - 1 in-          if indexN == -1-            then 0-            else popCount1Range (indexN *           8)           8 v + DVS.last u-        genCum2048 u = let indexN = DVS.length u in-          if indexN .&. 0xffffffff == 0-            then 0-            else popCount1Range ((indexN - 1) *    32)          32 v + DVS.last u-        genLayer0 u = let indexN = DVS.length u in-          if indexN == 0-            then 0-            else popCount1Range (indexN * 0x100000000) 0x100000000 v + DVS.last u-        genLayer1 u = let indexN = DVS.length u in-          let cum = if indexN == 0 -- TODO Check boundary at 4G???-              then  0-              else  csPoppyCum2048 !!! fromIntegral indexN in-          let a = popCount1Range (indexN * 32 +  0) 8 v in-          let b = popCount1Range (indexN * 32 +  8) 8 v in-          let c = popCount1Range (indexN * 32 + 16) 8 v in-          (   ( cum       .&. 0x00000000ffffffff)-          .|. ((a .<. 32) .&. 0x000003ff00000000)-          .|. ((b .<. 42) .&. 0x000ffc0000000000)-          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)-        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))-                  else genS (pcz, n + 1)-          else Nothing--instance TestBit CsPoppy where-  (.?.) = (.?.) . csPoppyBits-  {-# INLINE (.?.) #-}--instance BitRead CsPoppy where-  bitRead = fmap makeCsPoppy . bitRead--instance Rank1 CsPoppy where-  rank1 (CsPoppy v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock-    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)-          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)-          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff-          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32-          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42-          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52-          q                       = (p `div` 512) `mod` 4 -- quarter-          rankLayer1  | q == 0    = rankLayer1A-                      | q == 1    = rankLayer1A + rankLayer1B-                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C-                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D-                      | otherwise = undefined-          rankPrior               = (rankLayer0 + rankLayer1) :: Count-          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)--instance Select1 CsPoppy where-  select1 iv@(CsPoppy 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--sampleRange :: CsPoppy -> Count -> (Word64, Word64)-sampleRange (CsPoppy _ 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))

@@ -1,111 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2-    ( CsPoppy2(..)-    , Rank1(..)-    , makeCsPoppy2-    , sampleRange-    ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-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.Rank1-import           HaskellWorks.Data.RankSelect.Base.Select1-import           HaskellWorks.Data.Search-import           HaskellWorks.Data.Vector.AsVector64--data CsPoppy2 = CsPoppy2-  { csPoppy2Bits     :: DVS.Vector Word64-  , csPoppy2512Index :: DVS.Vector Word64-  , csPoppy2Layer0   :: DVS.Vector Word64-  , csPoppy2Layer1   :: DVS.Vector Word64-  , csPoppy2LayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit-  } deriving (Eq, Show)--instance AsVector64 CsPoppy2 where-  asVector64 = asVector64 . csPoppy2Bits-  {-# INLINE asVector64 #-}--popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count-popCount1Range start len = popCount1 . DVS.take len . DVS.drop start--makeCsPoppy2 :: DVS.Vector Word64 -> CsPoppy2-makeCsPoppy2 v = CsPoppy2-  { csPoppy2Bits     = v-  , csPoppy2512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index-  , csPoppy2Layer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0-  , csPoppy2Layer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1-  , csPoppy2LayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)-  }-  where csPoppy2Cum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048-        gen512Index u = let indexN = DVS.length u - 1 in-          if indexN == -1-            then 0-            else popCount1Range (indexN *           8)           8 v + DVS.last u-        genCum2048 u = let indexN = DVS.length u in-          if indexN .&. 0xffffffff == 0-            then 0-            else popCount1Range ((indexN - 1) *    32)          32 v + DVS.last u-        genLayer0 u = let indexN = DVS.length u in-          if indexN == 0-            then 0-            else popCount1Range (indexN * 0x100000000) 0x100000000 v + DVS.last u-        genLayer1 u = let indexN = DVS.length u in-          let cum = if indexN == 0 -- TODO Check boundary at 4G???-              then  0-              else  csPoppy2Cum2048 !!! fromIntegral indexN in-          let a = popCount1Range (indexN * 32 +  0) 8 v in-          let b = popCount1Range (indexN * 32 +  8) 8 v in-          let c = popCount1Range (indexN * 32 + 16) 8 v in-          (   ( cum       .&. 0x00000000ffffffff)-          .|. ((a .<. 32) .&. 0x000003ff00000000)-          .|. ((b .<. 42) .&. 0x000ffc0000000000)-          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)-        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))-                  else genS (pcz, n + 1)-          else Nothing--instance BitRead CsPoppy2 where-  bitRead = fmap makeCsPoppy2 . bitRead--instance Rank1 CsPoppy2 where-  rank1 (CsPoppy2 v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock-    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)-          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)-          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff-          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32-          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42-          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52-          q                       = (p `div` 512) `mod` 4 -- quarter-          rankLayer1  | q == 0    = rankLayer1A-                      | q == 1    = rankLayer1A + rankLayer1B-                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C-                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D-                      | otherwise = undefined-          rankPrior               = (rankLayer0 + rankLayer1) :: Count-          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)--instance Select1 CsPoppy2 where-  select1 (CsPoppy2 v i _ _ _) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)-    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)-          s = (i !!! q) :: Count-          wordAt = (i !!!)--sampleRange :: CsPoppy2 -> Count -> (Word64, Word64)-sampleRange (CsPoppy2 _ 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))

@@ -1,122 +0,0 @@-{-# LANGUAGE TypeFamilies   #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512-    ( Poppy512(..)-    , Rank1(..)-    , makePoppy512-    ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-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.Select0-import           HaskellWorks.Data.RankSelect.Base.Select1-import           HaskellWorks.Data.Search-import           HaskellWorks.Data.Succinct.BalancedParens.BalancedParens-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-import           HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt-import           HaskellWorks.Data.Vector.AsVector64-import           Prelude hiding (length)--data Poppy512 = Poppy512-  { poppy512Bits  :: DVS.Vector Word64-  , poppy512Index :: DVS.Vector Word64-  } deriving (Eq, Show)--instance AsVector64 Poppy512 where-  asVector64 = asVector64 . poppy512Bits-  {-# INLINE asVector64 #-}--makePoppy512 :: DVS.Vector Word64 -> Poppy512-makePoppy512 v = Poppy512-  { poppy512Bits  = v-  , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index-  }-  where gen512Index u = let indexN = DVS.length u - 1 in-          if indexN == -1-            then 0-            else popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v)) + DVS.last u--instance BitLength Poppy512 where-  bitLength v = length (poppy512Bits v) * bitLength (poppy512Bits v !!! 0)-  {-# INLINE bitLength #-}--instance TestBit Poppy512 where-  (.?.) = (.?.) . poppy512Bits-  {-# INLINE (.?.) #-}--instance BitRead Poppy512 where-  bitRead = fmap makePoppy512 . bitRead--instance Rank1 Poppy512 where-  rank1 (Poppy512 v i) p =-    (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)--instance Rank0 Poppy512 where-  rank0 (Poppy512 v i) p =-    p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)--instance Select1 Poppy512 where-  select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)-    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)-          s = (i !!! q) :: Count-          wordAt = (i !!!)--instance Select0 Poppy512 where-  select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s)-    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)-          s = (fromIntegral q * 512 - (i !!! q)) :: Count-          wordAt o = fromIntegral o * 512 - (i !!! o)--instance OpenAt Poppy512 where-  openAt = openAt . poppy512Bits-  {-# INLINE openAt #-}--instance CloseAt Poppy512 where-  closeAt = closeAt . poppy512Bits-  {-# INLINE closeAt #-}--instance FindOpenN Poppy512 where-  findOpenN = findOpenN . poppy512Bits-  {-# INLINE findOpenN    #-}--instance FindCloseN Poppy512 where-  findCloseN = findCloseN . poppy512Bits-  {-# INLINE findCloseN #-}--instance FindOpen Poppy512 where-  findOpen = findOpen . poppy512Bits-  {-# INLINE findOpen #-}--instance FindClose Poppy512 where-  findClose = findClose . poppy512Bits-  {-# INLINE findClose #-}--instance NewCloseAt Poppy512 where-  newCloseAt = newCloseAt . poppy512Bits-  {-# INLINE newCloseAt #-}--instance Enclose Poppy512 where-  enclose = enclose . poppy512Bits-  {-# INLINE enclose #-}--instance BalancedParens Poppy512 where-  firstChild  = firstChild  . poppy512Bits-  nextSibling = nextSibling . poppy512Bits-  parent      = parent      . poppy512Bits-  {-# INLINE firstChild  #-}-  {-# INLINE nextSibling #-}-  {-# INLINE parent      #-}

@@ -1,143 +0,0 @@-module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S-    ( Poppy512S(..)-    , Rank1(..)-    , makePoppy512S-    , sampleRange-    ) where--import qualified Data.Vector.Storable                                       as DVS-import           Data.Word-import           HaskellWorks.Data.AtIndex-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.Succinct.BalancedParens.BalancedParens-import           HaskellWorks.Data.Succinct.BalancedParens.CloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.Enclose-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-import           HaskellWorks.Data.Succinct.BalancedParens.FindCloseN-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpen-import           HaskellWorks.Data.Succinct.BalancedParens.FindOpenN-import           HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt-import           HaskellWorks.Data.Succinct.BalancedParens.OpenAt-import           HaskellWorks.Data.Vector.AsVector64-import           Prelude hiding (length)--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)--instance AsVector64 Poppy512S where-  asVector64 = asVector64 . poppy512SBits-  {-# INLINE asVector64 #-}--popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> 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 popCount1Range (indexN * 8) 8 v + DVS.last u-        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 Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))-                  else genS (pcz, n + 1)-          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      #-}

@@ -0,0 +1,120 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.RankSelect.BasicGen+  ( genRankSelectSpec+  , genRank0Select0Spec+  , 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++{-# 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 _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank0 10010010 over [0..8] should be 001223445" $ do+    let bs = fromJust (bitRead "10010010") :: s+    fmap (rank0 bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]++genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec+genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank0 11011010 00000000 over [0..16]" $ 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+    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]++genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 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+    let bs = fromJust (bitRead "10010010") :: s+    fmap (rank1 bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]++genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank1 11011010 00000000 over [0..9]" $ 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+    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]++genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 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+    let bs = fromJust $ bitRead "10010010" :: Word8+    fmap (select0 bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]++genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 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+    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]++genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 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]++genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 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+    let bs = fromJust $ bitRead "10010010" :: s+    fmap (select1 bs) [0..3] `shouldBe` [0, 1, 4, 7]++genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 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+    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+    let bs = fromJust $ bitRead "01000000 00000100" :: s+    fmap (select1 bs) [0..2] `shouldBe` [0, 2, 14]++genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 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+    let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s+    fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28]++genRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec+genRank1Select1Spec s = describe "For Rank 1" $ do+  genRank1UpTo8Spec     s+  genRank1UpTo16Spec    s+  genSelect1UpTo8Spec   s+  genSelect1UpTo16Spec  s+  genSelect1UpTo32Spec  s++genRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s) => s -> Spec+genRank0Select0Spec s = describe "For Rank 0" $ do+  genRank0UpTo8Spec     s+  genRank0UpTo16Spec    s+  genSelect0UpTo8Spec   s+  genSelect0UpTo16Spec  s+  genSelect0UpTo32Spec  s++genRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec+genRankSelectSpec s = describe "Generically" $ do+  genRank1Select1Spec    s+  genRank0Select0Spec    s

@@ -0,0 +1,94 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving       #-}+{-# LANGUAGE ScopedTypeVariables              #-}++module HaskellWorks.Data.RankSelect.CsPoppy2Spec (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.CsPoppy2+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.CsPoppy2.Rank1Spec" $ do+  genRank1Select1Spec (undefined :: CsPoppy2)+  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy2" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 v in+      rank1 v i === rank1 w i+  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy2" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -0,0 +1,94 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module HaskellWorks.Data.RankSelect.CsPoppySpec (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.CsPoppy+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.CsPoppy.Rank1Spec" $ do+  genRank1Select1Spec (undefined :: CsPoppy)+  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy v in+      rank1 v i === rank1 w i+  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -0,0 +1,35 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++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++{-# 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

@@ -0,0 +1,94 @@+{-# 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]

@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# 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++{-# 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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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+      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 = makePoppy512 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 = makePoppy512 cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++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++{-# 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

@@ -1,137 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.Succinct.BalancedParens.Internal.BroadwordSpec where---- import           Data.Maybe-import qualified Data.Vector.Storable                       as DVS-import           Data.Word--- import           HaskellWorks.Data.Bits.BitLength--- import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Bits.Broadword-import           HaskellWorks.Data.Bits.FromBitTextByteString-import           HaskellWorks.Data.Positioning-import           HaskellWorks.Data.Succinct.BalancedParens.FindClose-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--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.BalancedParens.BroadwordSpec" $ do-  describe "For (()(()())) 1101101000" $ do-    let bs = Broadword (91 :: Word64)-    it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-    it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-    it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-    it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    -- it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    -- it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    -- it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    -- it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-  -- describe "For (()(()())) 1101101000" $ do-  --   let bs = Broadword (fromJust (bitRead "1101101000") :: [Bool])-  --   it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-  --   it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-  --   it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-  --   it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-  --   it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-  --   it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-  --   it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-  --   it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-  --   it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-  --   it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    -- it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    -- it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    -- it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    -- it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-    -- it "firstChild 1"   $ firstChild  bs 1 `shouldBe` Just 2-    -- it "firstChild 4"   $ firstChild  bs 4 `shouldBe` Just 5-    -- it "nextSibling 2"  $ nextSibling bs 2 `shouldBe` Just 4-    -- it "nextSibling 5"  $ nextSibling bs 5 `shouldBe` Just 7-    -- it "parent 2" $ parent  bs  2 `shouldBe` Just 1-    -- it "parent 5" $ parent  bs  5 `shouldBe` Just 4-    -- it "depth  1" $ depth   bs  1 `shouldBe` Just 1-    -- it "depth  2" $ depth   bs  2 `shouldBe` Just 2-    -- it "depth  3" $ depth   bs  3 `shouldBe` Just 2-    -- it "depth  4" $ depth   bs  4 `shouldBe` Just 2-    -- it "depth  5" $ depth   bs  5 `shouldBe` Just 3-    -- it "depth  6" $ depth   bs  6 `shouldBe` Just 3-    -- it "depth  7" $ depth   bs  7 `shouldBe` Just 3-    -- it "depth  8" $ depth   bs  8 `shouldBe` Just 3-    -- it "depth  9" $ depth   bs  9 `shouldBe` Just 2-    -- it "depth 10" $ depth   bs 10 `shouldBe` Just 1-    -- it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` Just 5-    -- it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` Just 1-    -- it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` Just 0-    -- it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` Just 3-    -- it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` Just 1-    -- it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` Just 0-    -- it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` Just 1-    -- it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` Just 0-    -- it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` Just 0-    -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0-  describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do-    let bs = Broadword (DVS.head (fromBitTextByteString "11011010 00000000") :: Word64)-    it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-    it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-    it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-    it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    -- it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    -- it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    -- it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    -- it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-    -- it "firstChild 1"  $ firstChild  bs 1 `shouldBe` Just 2-    -- it "firstChild 4"  $ firstChild  bs 4 `shouldBe` Just 5-    -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4-    -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7-    -- it "parent 2" $ parent bs 2 `shouldBe` Just 1-    -- it "parent 5" $ parent bs 5 `shouldBe` Just 4-    -- it "depth  1" $ depth bs  1 `shouldBe` Just 1-    -- it "depth  2" $ depth bs  2 `shouldBe` Just 2-    -- it "depth  3" $ depth bs  3 `shouldBe` Just 2-    -- it "depth  4" $ depth bs  4 `shouldBe` Just 2-    -- it "depth  5" $ depth bs  5 `shouldBe` Just 3-    -- it "depth  6" $ depth bs  6 `shouldBe` Just 3-    -- it "depth  7" $ depth bs  7 `shouldBe` Just 3-    -- it "depth  8" $ depth bs  8 `shouldBe` Just 3-    -- it "depth  9" $ depth bs  9 `shouldBe` Just 2-    -- it "depth 10" $ depth bs 10 `shouldBe` Just 1-    -- it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` Just 5-    -- it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` Just 1-    -- it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` Just 0-    -- it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` Just 3-    -- it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` Just 1-    -- it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` Just 0-    -- it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` Just 1-    -- it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` Just 0-    -- it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` Just 0-    -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0-  -- describe "Does not suffer exceptions" $ do-  --   it "when calling nextSibling from valid locations" $ do-  --     forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do-  --       [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]-  it "Broadword findClose should behave the same as Naive findClose" $ do-    property $ \(w :: Word64) ->-      forAll (choose (1, 64 :: Count)) $ \p ->-        findClose w p == findClose (Broadword w) p

@@ -1,152 +0,0 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2Spec where--import qualified Data.Vector.Storable                                     as DVS-import           Data.Word--- import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShow--- import           HaskellWorks.Data.Bits.FromBitTextByteString--- import           HaskellWorks.Data.Succinct.BalancedParens--- import           HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax--- import           HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2-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 (DVS.fromList xs)--maxVectorSize :: Int-maxVectorSize = 16384-{-# INLINE maxVectorSize #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec2" $ do-  it "Skip tests" $ do-    True `shouldBe` True-  -- it "For a simple bit string can find close" $ do-  --   let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64-  --   let !rmm = mkRangeMinMax v-  --   findClose rmm 61 `shouldBe` findClose v 61-  -- it "findClose should return the same result" $ do-  --   forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do-  --     let !rmm = mkRangeMinMax v-  --     let len = bitLength v-  --     [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]-  -- it "findClose should return the same result over all counts" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     forAll (choose (1, bitLength v)) $ \p -> do-  --       let !rmm = mkRangeMinMax v-  --       findClose rmm p `shouldBe` findClose v p-  -- it "nextSibling should return the same result" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm = mkRangeMinMax v-  --     nextSibling rmm 0 `shouldBe` nextSibling v 0-  -- it "nextSibling should return the same result over all counts" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     forAll (choose (1, bitLength v)) $ \p -> do-  --       let !rmm = mkRangeMinMax v-  --       nextSibling rmm p `shouldBe` nextSibling v p-  -- it "Pass" $ do-  --   True `shouldBe` True-  -- it "rangeMinMaxBP should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2BP rmm2 `shouldBe` rangeMinMaxBP rmm1-  -- it "rangeMinMaxL0Excess should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L0Excess rmm2 `shouldBe` rangeMinMaxL0Excess rmm1-  -- it "rangeMinMaxL0Min should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1-  -- it "rangeMinMaxL0Max should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1-  -- it "rangeMinMaxL1Min should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1-  -- it "rangeMinMaxL1Max should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1-  -- it "rangeMinMaxL1Excess should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L1Excess rmm2 `shouldBe` rangeMinMaxL1Excess rmm1-  -- it "rangeMinMaxL2Min should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1-  -- it "rangeMinMaxL2Max should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1-  -- it "rangeMinMaxL2Excess should match" $ do-  --   forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do-  --     let !rmm1 = mkRangeMinMax   v-  --     let !rmm2 = mkRangeMinMax2  v-  --     rangeMinMax2L2Excess rmm2 `shouldBe` rangeMinMaxL2Excess rmm1-  -- describe "For example long bit string" $ do-  --   let v = fromBitTextByteString " \-  --     \ 01101101 01111100 10011111 01100101 11111100 01101111 00000000 00000000 10001010 11000000 01000010 01010010 01001101 01000101 00000000 00000000 \-  --     \ " :: DVS.Vector Word64-  --   let !rmm1 = mkRangeMinMax   v-  --   let !rmm2 = mkRangeMinMax2  v-  --   it "l0 max matches" $ do-  --     rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1-  --   it "l1 max matches" $ do-  --     rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1-  --   it "l2 max matches" $ do-  --     rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1-  --   it "l0 min matches" $ do-  --     rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1-  --   it "l1 min matches" $ do-  --     rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1-  --   it "l2 min matches" $ do-  --     putStrLn $ "--> data: "                 ++ show (BitShown (DVS.take 80 v))-  --     putStrLn $ "--> rangeMinMaxAL0Min: "    ++ show (DVS.take 80 (rangeMinMaxL0Min     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL0Max: "    ++ show (DVS.take 80 (rangeMinMaxL0Max     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL0Excess: " ++ show (DVS.take 80 (rangeMinMaxL0Excess  rmm1))-  --     putStrLn $ "--> rangeMinMaxBL0Min: "    ++ show (DVS.take 80 (rangeMinMax2L0Min    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL0Max: "    ++ show (DVS.take 80 (rangeMinMax2L0Max    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL0Excess: " ++ show (DVS.take 80 (rangeMinMax2L0Excess rmm2))-  --     putStrLn $ "--> rangeMinMaxAL1Min: "    ++ show (DVS.take 80 (rangeMinMaxL1Min     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL1Max: "    ++ show (DVS.take 80 (rangeMinMaxL1Max     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL1Excess: " ++ show (DVS.take 80 (rangeMinMaxL1Excess  rmm1))-  --     putStrLn $ "--> rangeMinMaxBL1Min: "    ++ show (DVS.take 80 (rangeMinMax2L1Min    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL1Max: "    ++ show (DVS.take 80 (rangeMinMax2L1Max    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL1Excess: " ++ show (DVS.take 80 (rangeMinMax2L1Excess rmm2))-  --     putStrLn $ "--> rangeMinMaxAL2Min: "    ++ show (DVS.take 80 (rangeMinMaxL2Min     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL2Max: "    ++ show (DVS.take 80 (rangeMinMaxL2Max     rmm1))-  --     putStrLn $ "--> rangeMinMaxAL2Excess: " ++ show (DVS.take 80 (rangeMinMaxL2Excess  rmm1))-  --     putStrLn $ "--> rangeMinMaxBL2Min: "    ++ show (DVS.take 80 (rangeMinMax2L2Min    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL2Max: "    ++ show (DVS.take 80 (rangeMinMax2L2Max    rmm2))-  --     putStrLn $ "--> rangeMinMaxBL2Excess: " ++ show (DVS.take 80 (rangeMinMax2L2Excess rmm2))-  --     rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1

@@ -1,62 +0,0 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec where--import qualified Data.Vector.Storable                                     as DVS-import           Data.Word--- import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitShow--- import           HaskellWorks.Data.Bits.FromBitTextByteString--- import           HaskellWorks.Data.Succinct.BalancedParens--- import           HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax-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 (DVS.fromList xs)--factor :: Int-factor = 16384-{-# INLINE factor #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec" $ do-  it "Skip tests" $ do-    True `shouldBe` True-  -- it "For a simple bit string can find close" $ do-  --   let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64-  --   let !rmm = mkRangeMinMax v-  --   findClose rmm 61 `shouldBe` findClose v 61-  -- it "findClose should return the same result" $ do-  --   forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do-  --     let !rmm = mkRangeMinMax v-  --     let len = bitLength v-  --     [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]-  -- it "findClose should return the same result over all counts" $ do-  --   forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do-  --     forAll (choose (1, bitLength v)) $ \p -> do-  --       let !rmm = mkRangeMinMax v-  --       findClose rmm p `shouldBe` findClose v p-  -- it "nextSibling should return the same result" $ do-  --   forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do-  --     let !rmm = mkRangeMinMax v-  --     nextSibling rmm 0 `shouldBe` nextSibling v 0-  -- it "nextSibling should return the same result over all counts" $ do-  --   forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do-  --     forAll (choose (1, bitLength v)) $ \p -> do-  --       let !rmm = mkRangeMinMax v-  --       nextSibling rmm p `shouldBe` nextSibling v p

@@ -1,135 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec where--import           Data.Maybe-import qualified Data.Vector.Storable                       as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitLength-import           HaskellWorks.Data.Bits.BitRead-import           HaskellWorks.Data.Bits.BitShow-import           HaskellWorks.Data.Succinct.BalancedParens-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 (DVS.fromList xs)--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec" $ do-  describe "For (()(()())) 1101101000" $ do-    let bs = SimpleBalancedParens (91 :: Word64)-    it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-    it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-    it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-    it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-  describe "For (()(()())) 1101101000" $ do-    let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool])-    it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-    it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-    it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-    it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-    it "firstChild 1"   $ firstChild  bs 1 `shouldBe` Just 2-    it "firstChild 4"   $ firstChild  bs 4 `shouldBe` Just 5-    it "nextSibling 2"  $ nextSibling bs 2 `shouldBe` Just 4-    it "nextSibling 5"  $ nextSibling bs 5 `shouldBe` Just 7-    it "parent 2" $ parent  bs  2 `shouldBe` Just 1-    it "parent 5" $ parent  bs  5 `shouldBe` Just 4-    it "depth  1" $ depth   bs  1 `shouldBe` Just 1-    it "depth  2" $ depth   bs  2 `shouldBe` Just 2-    it "depth  3" $ depth   bs  3 `shouldBe` Just 2-    it "depth  4" $ depth   bs  4 `shouldBe` Just 2-    it "depth  5" $ depth   bs  5 `shouldBe` Just 3-    it "depth  6" $ depth   bs  6 `shouldBe` Just 3-    it "depth  7" $ depth   bs  7 `shouldBe` Just 3-    it "depth  8" $ depth   bs  8 `shouldBe` Just 3-    it "depth  9" $ depth   bs  9 `shouldBe` Just 2-    it "depth 10" $ depth   bs 10 `shouldBe` Just 1-    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` Just 5-    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` Just 1-    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` Just 0-    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` Just 3-    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` Just 1-    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` Just 0-    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` Just 1-    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` Just 0-    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` Just 0-    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0-  describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do-    let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8)-    it "Test 1a" $ findClose bs  1 `shouldBe` Just 10-    it "Test 1b" $ findClose bs  2 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  3 `shouldBe` Just  3-    it "Test 1b" $ findClose bs  4 `shouldBe` Just  9-    it "Test 1b" $ findClose bs  5 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  6 `shouldBe` Just  6-    it "Test 1b" $ findClose bs  7 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  8 `shouldBe` Just  8-    it "Test 1b" $ findClose bs  9 `shouldBe` Just  9-    it "Test 1b" $ findClose bs 10 `shouldBe` Just 10-    it "Test 2a" $ findOpen  bs 10 `shouldBe` Just  1-    it "Test 2b" $ findOpen  bs  3 `shouldBe` Just  2-    it "Test 3a" $ enclose   bs  2 `shouldBe` Just  1-    it "Test 3b" $ enclose   bs  7 `shouldBe` Just  4-    it "firstChild 1"  $ firstChild  bs 1 `shouldBe` Just 2-    it "firstChild 4"  $ firstChild  bs 4 `shouldBe` Just 5-    it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4-    it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7-    it "parent 2" $ parent bs 2 `shouldBe` Just 1-    it "parent 5" $ parent bs 5 `shouldBe` Just 4-    it "depth  1" $ depth bs  1 `shouldBe` Just 1-    it "depth  2" $ depth bs  2 `shouldBe` Just 2-    it "depth  3" $ depth bs  3 `shouldBe` Just 2-    it "depth  4" $ depth bs  4 `shouldBe` Just 2-    it "depth  5" $ depth bs  5 `shouldBe` Just 3-    it "depth  6" $ depth bs  6 `shouldBe` Just 3-    it "depth  7" $ depth bs  7 `shouldBe` Just 3-    it "depth  8" $ depth bs  8 `shouldBe` Just 3-    it "depth  9" $ depth bs  9 `shouldBe` Just 2-    it "depth 10" $ depth bs 10 `shouldBe` Just 1-    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` Just 5-    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` Just 1-    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` Just 0-    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` Just 3-    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` Just 1-    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` Just 0-    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` Just 1-    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` Just 0-    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` Just 0-    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0-  describe "Does not suffer exceptions" $ do-    it "when calling nextSibling from valid locations" $ do-      forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do-        [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.EliasFano64Spec (spec) where--import           Data.Word-import           HaskellWorks.Data.Succinct.EliasFano64-import           Test.Hspec--{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.EliasFano64Spec" $ do-  it "Empty" $-    fromEliasFano64 (toEliasFano64 ([] :: [Word64])) `shouldBe` ([] :: [Word64])

@@ -1,120 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen-  ( genBinaryRankSelectSpec-  , genBinaryRank0Select0Spec-  , genBinaryRank1Select1Spec-  ) 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--{-# 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 _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank0 10010010 over [0..8] should be 001223445" $ do-    let bs = fromJust (bitRead "10010010") :: s-    fmap (rank0 bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]--genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec-genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank0 11011010 00000000 over [0..16]" $ 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-    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]--genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 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-    let bs = fromJust (bitRead "10010010") :: s-    fmap (rank1 bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]--genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec-genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do-  it "rank1 11011010 00000000 over [0..9]" $ 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-    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]--genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 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-    let bs = fromJust $ bitRead "10010010" :: Word8-    fmap (select0 bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]--genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 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-    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]--genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 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]--genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 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-    let bs = fromJust $ bitRead "10010010" :: s-    fmap (select1 bs) [0..3] `shouldBe` [0, 1, 4, 7]--genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 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-    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-    let bs = fromJust $ bitRead "01000000 00000100" :: s-    fmap (select1 bs) [0..2] `shouldBe` [0, 2, 14]--genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 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-    let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s-    fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28]--genBinaryRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec-genBinaryRank1Select1Spec s = describe "For Rank 1" $ do-  genRank1UpTo8Spec     s-  genRank1UpTo16Spec    s-  genSelect1UpTo8Spec   s-  genSelect1UpTo16Spec  s-  genSelect1UpTo32Spec  s--genBinaryRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s) => s -> Spec-genBinaryRank0Select0Spec s = describe "For Rank 0" $ do-  genRank0UpTo8Spec     s-  genRank0UpTo16Spec    s-  genSelect0UpTo8Spec   s-  genSelect0UpTo16Spec  s-  genSelect0UpTo32Spec  s--genBinaryRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec-genBinaryRankSelectSpec s = describe "Generically" $ do-  genBinaryRank1Select1Spec    s-  genBinaryRank0Select0Spec    s

@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving       #-}-{-# LANGUAGE ScopedTypeVariables              #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2Spec (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.Succinct.RankSelect.Binary.BasicGen-import           HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2-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.Succinct.RankSelect.Binary.CsPoppy2.Rank1Spec" $ do-  genBinaryRank1Select1Spec (undefined :: CsPoppy2)-  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy2" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 v in-      rank1 v i === rank1 w i-  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy2" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 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 = makeCsPoppy2 cs-      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppySpec (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.Succinct.RankSelect.Binary.BasicGen-import           HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy-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.Succinct.RankSelect.Binary.CsPoppy.Rank1Spec" $ do-  genBinaryRank1Select1Spec (undefined :: CsPoppy)-  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy v in-      rank1 v i === rank1 w i-  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy" $ do-    it "on empty bitvector" $-      let v = DVS.empty in-      let w = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy 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 = makeCsPoppy cs-      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving       #-}-{-# LANGUAGE ScopedTypeVariables              #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.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.Succinct.RankSelect.Binary.BasicGen-import           HaskellWorks.Data.Succinct.RankSelect.Binary.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.Succinct.RankSelect.Binary.Poppy512S.Rank1Spec" $ do-  genBinaryRank1Select1Spec (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 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.Succinct.RankSelect.Binary.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.Succinct.RankSelect.Binary.BasicGen-import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512-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.Succinct.RankSelect.Binary.Poppy512.Rank1Spec" $ do-  genBinaryRankSelectSpec (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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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-      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 = makePoppy512 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 = makePoppy512 cs-      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -1,35 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.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--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.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

@@ -1,52 +0,0 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.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--{-# 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