hw-eliasfano 0.1.1.0 → 0.1.1.1

raw patch · 14 files changed

+418/−278 lines, 14 filesdep +resourcetdep +temporary-resourcetdep ~generic-lensdep ~hw-packed-vectordep ~hw-primPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: resourcet, temporary-resourcet

Dependency ranges changed: generic-lens, hw-packed-vector, hw-prim

API changes (from Hackage documentation)

Files

• app/App/Codec.hs +19/−0
• app/App/Commands.hs +3/−1
• app/App/Commands/CreateIndex.hs +108/−0
• app/App/Commands/LoadSave.hs +8/−17
• app/App/Commands/Types.hs +6/−0
• bench/Main.hs +3/−8
• hw-eliasfano.cabal +106/−98
• src/HaskellWorks/Data/EliasFano.hs +31/−79
• src/HaskellWorks/Data/EliasFano/Internal.hs +79/−5
• src/HaskellWorks/Data/FromListWord64.hs +0/−10
• src/HaskellWorks/Data/ToListWord64.hs +0/−8
• test/HaskellWorks/Data/EliasFano/Reference.hs +31/−37
• test/HaskellWorks/Data/EliasFano/ReferenceSpec.hs +4/−6
• test/HaskellWorks/Data/EliasFanoSpec.hs +20/−9

@@ -0,0 +1,19 @@+module App.Codec+  ( decodeWord32s+  ) where++import Data.Semigroup ((<>))+import Data.Word++import qualified Data.Binary.Get      as G+import qualified Data.ByteString.Lazy as LBS++decodeWord32s :: LBS.ByteString -> [Word32]+decodeWord32s = fmap (G.runGet G.getWord32le) . go+  where go :: LBS.ByteString -> [LBS.ByteString]+        go lbs = case LBS.splitAt 4 lbs of+          (lt, rt) -> if LBS.length lt == 4+            then lt:go rt+            else if LBS.length lt == 0+              then []+              else [LBS.take 4 (lt <> LBS.replicate 4 0)]

@@ -1,7 +1,8 @@ module App.Commands where +import App.Commands.CreateIndex import App.Commands.LoadSave-import Data.Semigroup        ((<>))+import Data.Semigroup           ((<>)) import Options.Applicative  commands :: Parser (IO ())@@ -11,3 +12,4 @@ commandsGeneral = subparser $ mempty   <>  commandGroup "Commands:"   <>  cmdLoadSave+  <>  cmdCreateIndex

@@ -0,0 +1,108 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.CreateIndex+  ( cmdCreateIndex+  ) where++import App.Codec+import Control.Lens+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.Generics.Product.Any+import Data.Semigroup                          ((<>))+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.Log2+import HaskellWorks.Data.PackedVector.Internal+import HaskellWorks.Data.Positioning+import Options.Applicative                     hiding (columns)++import qualified App.Commands.Types                   as Z+import qualified Data.ByteString.Builder              as B+import qualified Data.ByteString.Lazy                 as LBS+import qualified HaskellWorks.Data.EliasFano.Internal as EF+import qualified System.Exit                          as IO+import qualified System.IO                            as IO+import qualified System.IO.Temp                       as RIO++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++readWord32s :: MonadIO m => FilePath -> m [Word32]+readWord32s fp = do+  lbs <- liftIO $ LBS.readFile fp++  return (decodeWord32s lbs)++w32To64 :: Word32 -> Word64+w32To64 = fromIntegral++runCreateIndex :: Z.CreateIndexOptions -> IO ()+runCreateIndex opts = runResourceT $ do+  let output = opts ^. the @"output"+  (maybeEnd, count) <- EF.foldCountAndLast <$> readWord32s (opts ^. the @"input")++  case maybeEnd of+    Just end -> do+      let length'   = count+      let loBits'   = fromIntegral (log2 (fromIntegral end `EF.divup` length')) :: Count+      let hiMask    = maxBound .<. loBits' :: Word64+      let loMask    = comp hiMask :: Word64+      his <- fmap ((.>. loBits') . (.&. hiMask) . w32To64) <$> readWord32s (opts ^. the @"input")+      los <- fmap ((.&. loMask)                 . w32To64) <$> readWord32s (opts ^. the @"input")++      let hiWords       = EF.hiSegmentToWords his+      let loWords       = packBits loBits' los+      let efLoBitCount  = loBits'+      let efCount       = length'++      liftIO . IO.putStrLn $ "Lo bit count: " <> show efLoBitCount+      liftIO . IO.putStrLn $ "Entries: " <> show efCount++      (_, _, hHi) <- RIO.openBinaryTempFile Nothing (output <> ".hi")+      (_, _, hLo) <- RIO.openBinaryTempFile Nothing (output <> ".lo")++      liftIO $ LBS.hPut hHi (B.toLazyByteString (foldMap B.word64LE hiWords)) >> IO.hFlush hHi+      liftIO $ LBS.hPut hLo (B.toLazyByteString (foldMap B.word64LE loWords)) >> IO.hFlush hLo++      liftIO $ IO.hSeek hHi IO.AbsoluteSeek 0+      liftIO $ IO.hSeek hLo IO.AbsoluteSeek 0++      hiSize <- liftIO $ IO.hFileSize hHi+      loSize <- liftIO $ IO.hFileSize hLo++      loBytes <- liftIO $ LBS.hGetContents hLo+      hiBytes <- liftIO $ LBS.hGetContents hHi++      liftIO $ LBS.writeFile output $ B.toLazyByteString $ mempty+        <> B.word64LE count+        <> B.word64LE (fromIntegral loSize)+        <> B.word64LE (fromIntegral hiSize)+        <> B.lazyByteString loBytes+        <> B.lazyByteString hiBytes++      return ()++    Nothing -> do+      liftIO $ IO.hPutStrLn IO.stderr "Empty input"+      liftIO   IO.exitFailure++optsCreateIndex :: Parser Z.CreateIndexOptions+optsCreateIndex = Z.CreateIndexOptions+  <$> strOption+        (   long "input"+        <>  short 'i'+        <>  help "Input file of little-endian monotonically increasing word32s"+        <>  metavar "FILE"+        )+  <*> strOption+        (   long "output"+        <>  short 'o'+        <>  help "Output files"+        <>  metavar "FILE"+        )++cmdCreateIndex :: Mod CommandFields (IO ())+cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex

@@ -6,14 +6,15 @@   ( cmdLoadSave   ) where +import App.Codec import Control.Lens import Data.Generics.Product.Any-import Data.Semigroup            ((<>))+import Data.Semigroup                       ((<>)) import Data.Word-import Options.Applicative       hiding (columns)+import HaskellWorks.Data.RankSelect.CsPoppy+import Options.Applicative                  hiding (columns)  import qualified App.Commands.Types                            as Z-import qualified Data.Binary.Get                               as G import qualified Data.ByteString.Lazy                          as LBS import qualified Data.Vector.Storable                          as DVS import qualified HaskellWorks.Data.EliasFano                   as EF@@ -23,24 +24,14 @@ {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-} {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} -decodeWord32s :: LBS.ByteString -> [Word32]-decodeWord32s = fmap (G.runGet G.getWord32le) . go-  where go :: LBS.ByteString -> [LBS.ByteString]-        go lbs = case LBS.splitAt 4 lbs of-          (lt, rt) -> if LBS.length lt == 4-            then lt:go rt-            else if LBS.length lt == 0-              then []-              else [LBS.take 4 (lt <> LBS.replicate 4 0)]- runLoadSave :: Z.LoadSaveOptions -> IO () runLoadSave opts = do-  lbs <- LBS.readFile (opts ^. the @"input")+  let input = opts ^. the @"output"+  lbs <- LBS.readFile input   let ws = fmap fromIntegral (decodeWord32s lbs) :: [Word64]-  let ef = EF.fromListWord64 ws :: EF.EliasFano-  -- let x = DVS.length (PV.swBuffer (EF.efCount ef))+  let ef = EF.fromWord64s ws :: EF.EliasFano   IO.putStrLn $ "Eliasfano:"-    <> " bits: "  <> show (ef & EF.efBucketBits & DVS.length                )+    <> " bits: "  <> show (ef & EF.efBucketBits & csPoppyBits & DVS.length  )     <> " count: " <> show (ef & EF.efLoSegments & PV.swBuffer & DVS.length  )     <> " pv: "    <> show (ef & EF.efCount                                  )     <> " lbc: "   <> show (ef & EF.efLoBitCount                             )

@@ -3,11 +3,17 @@  module App.Commands.Types   ( LoadSaveOptions(..)+  , CreateIndexOptions(..)   ) where  import GHC.Generics  data LoadSaveOptions = LoadSaveOptions+  { input  :: FilePath+  , output :: FilePath+  } deriving (Eq, Show, Generic)++data CreateIndexOptions = CreateIndexOptions   { input  :: FilePath   , output :: FilePath   } deriving (Eq, Show, Generic)

@@ -9,7 +9,6 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.EliasFano import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.PackedVector import System.Environment import System.IO.MMap @@ -31,17 +30,13 @@   !ibFr  <- mmapFileForeignPtr filename ReadOnly Nothing   let !ib  = fromForeignRegion ibFr  :: DVS.Vector Word64   let !positions = getPositions ib-  let !ef = fromListWord64 positions :: EliasFano-  putStrLn $ "Position count: " <> show (efCount ef)-  putStrLn $ "bucket size: " <> show (8 * DVS.length (efBucketBits ef))-  putStrLn $ "lo size: " <> show (8 * DVS.length (swBuffer (efLoSegments ef)))-  putStrLn $ "efLoBitCount: " <> show (efLoBitCount ef)+  let !_ = fromWord64s positions :: EliasFano   return ()  loadBitString :: FilePath -> IO BS.ByteString loadBitString filepath = do-  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing-  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+  (fptr :: ForeignPtr Word8, offset, sz) <- mmapFileForeignPtr filepath ReadOnly Nothing+  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset sz   return bs  benchEliasFano :: [Benchmark]

@@ -1,20 +1,20 @@ cabal-version:  2.2 -name:           hw-eliasfano-version:        0.1.1.0-synopsis:       Elias-Fano-description:    Please see README.md-category:       Data, Succinct Data Structures, Data Structures-homepage:       http://github.com/haskell-works/hw-eliasfano#readme-bug-reports:    https://github.com/haskell-works/hw-eliasfano/issues-author:         John Ky-maintainer:     newhoggy@gmail.com-copyright:      2016-2019 John Ky-license:        BSD-3-Clause-license-file:   LICENSE-build-type:     Simple-extra-source-files:-    README.md+name:                   hw-eliasfano+version:                0.1.1.1+synopsis:               Elias-Fano+description:            Please see README.md+category:               Data, Succinct Data Structures, Data Structures+homepage:               http://github.com/haskell-works/hw-eliasfano#readme+bug-reports:            https://github.com/haskell-works/hw-eliasfano/issues+author:                 John Ky+maintainer:             newhoggy@gmail.com+copyright:              2016-2019 John Ky+license:                BSD-3-Clause+license-file:           LICENSE+tested-with:            GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2+build-type:             Simple+extra-source-files:     README.md  source-repository head   type: git@@ -26,109 +26,117 @@ common binary               { build-depends: binary               >= 0.8        && < 0.9    } common criterion            { build-depends: criterion            >= 1.5.5.0    && < 1.6    } common deepseq              { build-depends: deepseq              >= 1.4        && < 1.5    }-common generic-lens         { build-depends: generic-lens         >= 1.1.0.0    && < 1.2    }+common generic-lens         { build-depends: generic-lens         >= 1.2.0.1    && < 1.3    } common hedgehog             { build-depends: hedgehog             >= 0.6        && < 1.1    } common hspec                { build-depends: hspec                >= 2.7.1      && < 3      } common hw-bits              { build-depends: hw-bits              >= 0.7.0.6    && < 0.8    } common hw-hedgehog          { build-depends: hw-hedgehog          >= 0.1.0.3    && < 0.2    } common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1.0.7    && < 0.2    } common hw-int               { build-depends: hw-int               >= 0.0.0.3    && < 0.1    }-common hw-packed-vector     { build-depends: hw-packed-vector     >= 0.0.0.2    && < 0.1    }-common hw-prim              { build-depends: hw-prim              >= 0.6.2.25   && < 0.7    }+common hw-packed-vector     { build-depends: hw-packed-vector     >= 0.0.0.3    && < 0.1    }+common hw-prim              { build-depends: hw-prim              >= 0.6.2.26   && < 0.7    } common hw-rankselect        { build-depends: hw-rankselect        >= 0.13       && < 0.14   } common hw-rankselect-base   { build-depends: hw-rankselect-base   >= 0.3.2.1    && < 0.4    } common lens                 { build-depends: lens                 >= 4          && < 5      } common mmap                 { build-depends: mmap                 >= 0.5.9      && < 0.6    }-common optparse-applicative { build-depends: optparse-applicative >= 0.14       && < 0.15   }+common optparse-applicative { build-depends: optparse-applicative >= 0.14       && < 0.16   }+common resourcet            { build-depends: resourcet            >= 1.2.2      && < 1.3    }+common temporary-resourcet  { build-depends: temporary-resourcet  >= 0.1.0.1    && < 0.2    } common vector               { build-depends: vector               >= 0.12.0.3   && < 0.13   }  common semigroups   { if impl(ghc <  8    ) { build-depends: semigroups     >= 0.16     && < 0.19 } }  common config-  default-language:   Haskell2010-  ghc-options:        -Wall+  default-language:     Haskell2010+  ghc-options:          -Wall  library-  import:   base, config-          , deepseq-          , hw-bits-          , hw-int-          , hw-packed-vector-          , hw-prim-          , hw-rankselect-          , hw-rankselect-base-          , vector-  exposed-modules:-      HaskellWorks.Data.EliasFano-      HaskellWorks.Data.EliasFano.Internal-      HaskellWorks.Data.FromListWord64-      HaskellWorks.Data.ToListWord64-  other-modules:      Paths_hw_eliasfano-  autogen-modules:    Paths_hw_eliasfano-  hs-source-dirs:     src+  import:               base, config+                      , deepseq+                      , hw-bits+                      , hw-int+                      , hw-packed-vector+                      , hw-prim+                      , hw-rankselect+                      , hw-rankselect-base+                      , temporary-resourcet+                      , vector+  exposed-modules:      HaskellWorks.Data.EliasFano+                        HaskellWorks.Data.EliasFano.Internal+  other-modules:        Paths_hw_eliasfano+  autogen-modules:      Paths_hw_eliasfano+  hs-source-dirs:       src  executable hw-eliasfano-  import:   base, config-          , binary-          , bytestring-          , generic-lens-          , hw-packed-vector-          , lens-          , optparse-applicative-          , semigroups-          , vector-  main-is:        Main.hs-  hs-source-dirs: app-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N -O2-  build-depends:  hw-eliasfano-  other-modules:-      App.Commands-      App.Commands.LoadSave-      App.Commands.Types+  import:               base, config+                      , binary+                      , bytestring+                      , generic-lens+                      , hw-bits+                      , hw-packed-vector+                      , hw-prim+                      , hw-rankselect+                      , hw-rankselect-base+                      , lens+                      , optparse-applicative+                      , resourcet+                      , semigroups+                      , temporary-resourcet+                      , vector+  main-is:              Main.hs+  hs-source-dirs:       app+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:        hw-eliasfano+  other-modules:        App.Codec+                        App.Commands+                        App.Commands.CreateIndex+                        App.Commands.LoadSave+                        App.Commands.Types  test-suite hw-eliasfano-test-  import:   base, config-          , hedgehog-          , hspec-          , hw-bits-          , hw-hedgehog-          , hw-hspec-hedgehog-          , hw-int-          , hw-packed-vector-          , hw-prim-          , vector-  type:               exitcode-stdio-1.0-  main-is:            Spec.hs-  hs-source-dirs:     test-  ghc-options:        -Wall -threaded -rtsopts -with-rtsopts=-N-  build-depends:      hw-eliasfano-  other-modules:-      HaskellWorks.Data.EliasFano.Reference-      HaskellWorks.Data.EliasFano.ReferenceSpec-      HaskellWorks.Data.EliasFanoSpec-      Paths_hw_eliasfano-  autogen-modules:    Paths_hw_eliasfano-  default-language:   Haskell2010-  build-tool-depends: hspec-discover:hspec-discover+  import:               base, config+                      , hedgehog+                      , hspec+                      , hw-bits+                      , hw-hedgehog+                      , hw-hspec-hedgehog+                      , hw-int+                      , hw-packed-vector+                      , hw-prim+                      , hw-rankselect+                      , hw-rankselect-base+                      , vector+  type:                 exitcode-stdio-1.0+  main-is:              Spec.hs+  hs-source-dirs:       test+  ghc-options:          -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:        hw-eliasfano+  other-modules:        HaskellWorks.Data.EliasFano.Reference+                        HaskellWorks.Data.EliasFano.ReferenceSpec+                        HaskellWorks.Data.EliasFanoSpec+                        Paths_hw_eliasfano+  autogen-modules:      Paths_hw_eliasfano+  default-language:     Haskell2010+  build-tool-depends:   hspec-discover:hspec-discover  benchmark bench-  import:   base, config-          , base-          , bytestring-          , criterion-          , hedgehog-          , hspec-          , hw-bits-          , hw-hedgehog-          , hw-hspec-hedgehog-          , hw-int-          , hw-packed-vector-          , hw-prim-          , mmap-          , vector-  type:               exitcode-stdio-1.0-  main-is:            Main.hs-  hs-source-dirs:     bench-  other-modules:      Paths_hw_eliasfano-  build-depends:      hw-eliasfano-  autogen-modules:    Paths_hw_eliasfano+  import:               base, config+                      , base+                      , bytestring+                      , criterion+                      , hedgehog+                      , hspec+                      , hw-bits+                      , hw-hedgehog+                      , hw-hspec-hedgehog+                      , hw-int+                      , hw-packed-vector+                      , hw-prim+                      , mmap+                      , vector+  type:                 exitcode-stdio-1.0+  main-is:              Main.hs+  hs-source-dirs:       bench+  other-modules:        Paths_hw_eliasfano+  build-depends:        hw-eliasfano+  autogen-modules:      Paths_hw_eliasfano

@@ -4,35 +4,29 @@  module HaskellWorks.Data.EliasFano   ( EliasFano(..)-  , FromListWord64(..)-  , ToListWord64(..)-  , divup-  , hiSegmentToBucketBits-  , bucketBitsToHiSegment+  , fromWord64s+  , toWord64s+  , empty   , size   ) where  import Control.DeepSeq-import Data.Bits                                 (countLeadingZeros, finiteBitSize)-import Data.Int import Data.Word import GHC.Generics import HaskellWorks.Data.AtIndex                 hiding (end) import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.Log2 import HaskellWorks.Data.EliasFano.Internal-import HaskellWorks.Data.FromListWord64 import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Select1-import HaskellWorks.Data.ToListWord64+import HaskellWorks.Data.RankSelect.CsPoppy import Prelude                                   hiding (length, take)  import qualified Data.Vector.Storable                          as DVS import qualified HaskellWorks.Data.PackedVector.PackedVector64 as PV-import qualified Prelude                                       as P  data EliasFano = EliasFano-  { efBucketBits :: !(DVS.Vector Word64)  -- 1 marks bucket, 0 marks skip to next+  { efBucketBits :: !CsPoppy              -- 1 marks bucket, 0 marks skip to next   , efLoSegments :: !PV.PackedVector64    -- Lower segment of each entry   , efLoBitCount :: !Count                -- Number of bits in each lower segment   , efCount      :: !Count                -- Number of entries@@ -43,76 +37,34 @@ size :: EliasFano -> Count size = efCount --- | Calculates ceil (n / d) for small numbers-divup :: Word64 -> Word64 -> Word64-divup n d = fromIntegral (-((-sn) `div` sd)) :: Word64-  where sd = fromIntegral d :: Int64-        sn = fromIntegral n :: Int64--bucketBoolsToBucketWords :: [Bool] -> DVS.Vector Word64-bucketBoolsToBucketWords bs = DVS.unfoldrN ((P.length bs `div` 64) + 1) gen bs-  where gen :: [Bool] -> Maybe (Word64, [Bool])-        gen cs = if not (null cs) then genWord cs 0 0 else Nothing-        genWord :: [Bool] -> Count -> Word64 -> Maybe (Word64, [Bool])-        genWord (True :cs) i acc | i < 64 = genWord cs (i + 1) (acc .|. (1 .<. i))-        genWord (False:cs) i acc | i < 64 = genWord cs (i + 1)  acc-        genWord        cs  _ acc = Just (acc, cs)--bucketWordsToBucketBools :: Count -> DVS.Vector Word64 -> [Bool]-bucketWordsToBucketBools n v = fst (DVS.foldl go (id, n) v) []-  where go :: ([Bool] -> [Bool], Count) -> Word64 -> ([Bool] -> [Bool], Count)-        go (bs, c) w | c > 0 = case goWord c 64 w of-                                (cs, finalCount) -> (bs . cs, finalCount)-        go (bs, _) _         = (bs, 0)-        goWord :: Count -> Count -> Word64 -> ([Bool] -> [Bool], Count)-        goWord c i w | c > 0 && i > 0 = let b = (w .&. 1) /= 0-                                        in case goWord (if b then c - 1 else c) (i - 1) (w .>. 1) of-                                              (bs, finalCount) -> ((b:) . bs, finalCount)-        goWord c _ _                  = (id, c)--hiSegmentToBucketBits :: Word64 -> [Word64] -> [Bool]-hiSegmentToBucketBits lastWord = go 0-  where go :: Word64 -> [Word64] -> [Bool]-        go i []     | i >= lastWord = []-        go i (a:as) | i == a        = True:go i as-        go i (a:as) | i <  a        = False:go (i + 1) (a:as)-        go i []     = False:go (i + 1) []-        go _ (_:_)  = error "Invalid entry"--bucketBitsToHiSegment :: [Bool] -> [Word64]-bucketBitsToHiSegment = go 0-  where go :: Word64 -> [Bool] -> [Word64]-        go _ []          = []-        go i (True:bs)   = i:go  i      bs-        go i (False: bs) =   go (i + 1) bs+empty :: EliasFano+empty = EliasFano+  { efBucketBits  = makeCsPoppy DVS.empty+  , efLoSegments  = PV.empty+  , efLoBitCount  = 0+  , efCount       = 0+  } -instance FromListWord64 EliasFano where-  fromListWord64 ws = case lastMaybe ws of-    Just end' -> EliasFano-      { efBucketBits  = bucketBoolsToBucketWords (hiSegmentToBucketBits (bucketEnd - 1) his)-      , efLoSegments  = PV.fromList loBits' los-      , efLoBitCount  = loBits'-      , efCount       = length'-      }-      where length'   = length ws-            loBits'   = fromIntegral (log2 (end' `divup` length')) :: Count-            hiMask    = maxBound .<. loBits' :: Word64-            loMask    = comp hiMask :: Word64-            his       = (.>. loBits') . (.&. hiMask) <$> ws-            los       = (.&. loMask) <$> ws-            hiEnd     = end' .>. loBits'-            bucketEnd = 1 .<. fromIntegral (finiteBitSize hiEnd - countLeadingZeros hiEnd) :: Word64-    Nothing -> EliasFano-      { efBucketBits  = DVS.empty-      , efLoSegments  = PV.empty-      , efLoBitCount  = 0-      , efCount       = 0-      }+fromWord64s :: [Word64] -> EliasFano+fromWord64s ws = case foldCountAndLast ws of+  (Just end', _) -> EliasFano+    { efBucketBits  = makeCsPoppy . DVS.fromList $ hiSegmentToWords his+    , efLoSegments  = PV.fromList loBits' los+    , efLoBitCount  = loBits'+    , efCount       = length'+    }+    where length'   = length ws+          loBits'   = fromIntegral (log2 (end' `divup` length')) :: Count+          hiMask    = maxBound .<. loBits' :: Word64+          loMask    = comp hiMask :: Word64+          his       = (.>. loBits') . (.&. hiMask) <$> ws+          los       = (.&. loMask) <$> ws+  (Nothing, _) -> empty -instance ToListWord64 EliasFano where-  toListWord64 ef = uncurry combine <$> zip (bucketBitsToHiSegment bucketBits) (PV.toList (efLoSegments ef))-    where combine hi lo = (hi .<. efLoBitCount ef) .|. lo-          bucketBits = bucketWordsToBucketBools (efCount ef) (efBucketBits ef)+toWord64s :: EliasFano -> [Word64]+toWord64s ef = uncurry combine <$> zip (bucketBitsToHiSegment bucketBits) (PV.toList (efLoSegments ef))+  where combine hi lo = (hi .<. efLoBitCount ef) .|. lo+        bucketBits = bucketWordsToBucketBools (efCount ef) (csPoppyBits (efBucketBits ef))  instance Container EliasFano where   type Elem EliasFano = Word64

@@ -1,8 +1,82 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}+ module HaskellWorks.Data.EliasFano.Internal-  ( lastMaybe+  ( divup+  , hiSegmentToBucketBits+  , bucketBitsToHiSegment+  , bucketBoolsToBucketWords+  , bucketWordsToBucketBools+  , hiSegmentToWords+  , foldCountAndLast   ) where -lastMaybe :: [a] -> Maybe a-lastMaybe (a:as@(b:bs)) = lastMaybe as-lastMaybe [a]           = Just a-lastMaybe _             = Nothing+import Data.Int+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning+import Prelude                        hiding (length, take)++import qualified Data.Vector.Storable as DVS+import qualified Prelude              as P++foldCountAndLast :: Foldable t => t a -> (Maybe a, Count)+foldCountAndLast = foldl go (Nothing, 0)+  where go :: (Maybe a, Count) -> a -> (Maybe a, Count)+        go (_, n) a = (Just a, n + 1)+{-# INLINE foldCountAndLast #-}++-- | Calculates ceil (n / d) for small numbers+divup :: Word64 -> Word64 -> Word64+divup n d = fromIntegral (-((-sn) `div` sd)) :: Word64+  where sd = fromIntegral d :: Int64+        sn = fromIntegral n :: Int64++bucketBoolsToBucketWords :: [Bool] -> DVS.Vector Word64+bucketBoolsToBucketWords bs = DVS.unfoldrN ((P.length bs `div` 64) + 1) gen bs+  where gen :: [Bool] -> Maybe (Word64, [Bool])+        gen cs = if not (null cs) then genWord cs 0 0 else Nothing+        genWord :: [Bool] -> Count -> Word64 -> Maybe (Word64, [Bool])+        genWord (True :cs) i acc | i < 64 = genWord cs (i + 1) (acc .|. (1 .<. i))+        genWord (False:cs) i acc | i < 64 = genWord cs (i + 1)  acc+        genWord        cs  _ acc = Just (acc, cs)++bucketWordsToBucketBools :: Count -> DVS.Vector Word64 -> [Bool]+bucketWordsToBucketBools n v = fst (DVS.foldl go (id, n) v) []+  where go :: ([Bool] -> [Bool], Count) -> Word64 -> ([Bool] -> [Bool], Count)+        go (bs, c) w | c > 0 = case goWord c 64 w of+                                (cs, finalCount) -> (bs . cs, finalCount)+        go (bs, _) _         = (bs, 0)+        goWord :: Count -> Count -> Word64 -> ([Bool] -> [Bool], Count)+        goWord c i w | c > 0 && i > 0 = let b = (w .&. 1) /= 0+                                        in case goWord (if b then c - 1 else c) (i - 1) (w .>. 1) of+                                              (bs, finalCount) -> ((b:) . bs, finalCount)+        goWord c _ _                  = (id, c)++hiSegmentToWords :: [Word64] -> [Word64]+hiSegmentToWords = go 0 0 0+  where go :: Count -> Word64 -> Word64 -> [Word64] -> [Word64]+        go n acc lst us@(v:vs) = if n < 64+          then if lst < v+            then go (n + 1)  acc                (lst + 1) us+            else go (n + 1) (acc .|. (1 .<. n))  v        vs+          else acc:go 0 0 lst us+        go 0 _   _    _         = []+        go _ acc _    _         = [acc]++hiSegmentToBucketBits :: Word64 -> [Word64] -> [Bool]+hiSegmentToBucketBits lastWord = go 0+  where go :: Word64 -> [Word64] -> [Bool]+        go i []     | i >= lastWord = []+        go i (a:as) | i == a        = True:go i as+        go i (a:as) | i <  a        = False:go (i + 1) (a:as)+        go i []     = False:go (i + 1) []+        go _ (_:_)  = error "Invalid entry"++bucketBitsToHiSegment :: [Bool] -> [Word64]+bucketBitsToHiSegment = go 0+  where go :: Word64 -> [Bool] -> [Word64]+        go _ []          = []+        go i (True:bs)   = i:go  i      bs+        go i (False: bs) =   go (i + 1) bs

@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.FromListWord64-  ( FromListWord64(..)-  ) where--import Data.Word--class FromListWord64 a where-  fromListWord64 :: [Word64] -> a

@@ -1,8 +0,0 @@-module HaskellWorks.Data.ToListWord64-  ( ToListWord64(..)-  ) where--import Data.Word--class ToListWord64 a where-  toListWord64 :: a -> [Word64]

@@ -3,21 +3,21 @@ module HaskellWorks.Data.EliasFano.Reference   ( EliasFano(..)   , divup+  , fromWord64s+  , toWord64s   , hiSegmentToBucketBits   , bucketBitsToHiSegment   ) where -import Data.Bits                            (countLeadingZeros, finiteBitSize)+import Data.Bits                      (countLeadingZeros, finiteBitSize) import Data.Int import Data.Word-import HaskellWorks.Data.AtIndex            hiding (end)+import HaskellWorks.Data.AtIndex      hiding (end) import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.Log2-import HaskellWorks.Data.EliasFano.Internal-import HaskellWorks.Data.FromListWord64+import HaskellWorks.Data.Foldable import HaskellWorks.Data.Positioning-import HaskellWorks.Data.ToListWord64-import Prelude                              hiding (length, take)+import Prelude                        hiding (length, take)  data EliasFano = EliasFano   { efBucketBits :: [Bool]   -- 1 marks bucket, 0 marks skip to next@@ -48,35 +48,29 @@         go i (True:bs)   = i:go  i      bs         go i (False: bs) =   go (i + 1) bs -instance FromListWord64 EliasFano where-  fromListWord64 ws = case lastMaybe ws of-    Just end' -> EliasFano-      { efBucketBits  = hiSegmentToBucketBits (bucketEnd - 1) his-      , efLoSegments  = los-      , efLoBitCount  = loBits'-      , efCount       = length'-      }-      where length'   = length ws-            loBits'   = fromIntegral (log2 ((end' + 2) `divup` length')) :: Count-            hiMask    = maxBound .<. loBits' :: Word64-            loMask    = comp hiMask :: Word64-            his       = (.>. loBits') . (.&. hiMask) <$> ws-            los       = (.&. loMask) <$> ws-            hiEnd     = end' .>. loBits'-            bucketEnd = 1 .<. fromIntegral (finiteBitSize hiEnd - countLeadingZeros hiEnd) :: Word64-    Nothing -> EliasFano-      { efBucketBits  = []-      , efLoSegments  = []-      , efLoBitCount  = 0-      , efCount       = 0-      }--instance ToListWord64 EliasFano where-  toListWord64 ef = uncurry combine <$> zip (bucketBitsToHiSegment (efBucketBits ef)) (efLoSegments ef)-    where combine hi lo = (hi .<. efLoBitCount ef) .|. lo+fromWord64s :: [Word64] -> EliasFano+fromWord64s ws = case foldLast ws of+  Just end' -> EliasFano+    { efBucketBits  = hiSegmentToBucketBits (bucketEnd - 1) his+    , efLoSegments  = los+    , efLoBitCount  = loBits'+    , efCount       = length'+    }+    where length'   = length ws+          loBits'   = fromIntegral (log2 ((end' + 2) `divup` length')) :: Count+          hiMask    = maxBound .<. loBits' :: Word64+          loMask    = comp hiMask :: Word64+          his       = (.>. loBits') . (.&. hiMask) <$> ws+          los       = (.&. loMask) <$> ws+          hiEnd     = end' .>. loBits'+          bucketEnd = 1 .<. fromIntegral (finiteBitSize hiEnd - countLeadingZeros hiEnd) :: Word64+  Nothing -> EliasFano+    { efBucketBits  = []+    , efLoSegments  = []+    , efLoBitCount  = 0+    , efCount       = 0+    } --- instance AtIndex EliasFano where---   (!!!)   v i = v !! fromIntegral i---   atIndex v i = v !! fromIntegral i---   {-# INLINE (!!!)   #-}---   {-# INLINE atIndex #-}+toWord64s :: EliasFano -> [Word64]+toWord64s ef = uncurry combine <$> zip (bucketBitsToHiSegment (efBucketBits ef)) (efLoSegments ef)+  where combine hi lo = (hi .<. efLoBitCount ef) .|. lo

@@ -4,8 +4,6 @@  import Data.Word import HaskellWorks.Data.EliasFano.Reference-import HaskellWorks.Data.FromListWord64-import HaskellWorks.Data.ToListWord64 import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec@@ -19,7 +17,7 @@ spec = describe "HaskellWorks.Data.EliasFano.ReferenceSpec" $ do   it "List to EliasFano" $ require $ withTests 1 $ property $ do     ws <- forAll $ pure $ [2, 3, 5, 7, 11, 13, 24]-    let actual = fromListWord64 ws+    let actual = fromWord64s ws     let expected = EliasFano           { efBucketBits  = [ True                             , True@@ -67,11 +65,11 @@           , efLoBitCount  = 2           , efCount       = 7           }-    let actual = toListWord64 ws+    let actual = toWord64s ws     let expected = [2, 3, 5, 7, 11, 13, 24]     actual === expected   it "Round trip" $ require $ property $ do     vs <- forAll $ G.list (R.linear 0 100) (G.word64 (R.linear 1 20))     ws <- forAll $ pure $ drop 1 $ scanl (+) 0xffffffffffffffff vs-    ef :: EliasFano <- forAll $ pure $ fromListWord64 ws-    toListWord64 ef === (ws :: [Word64])+    ef :: EliasFano <- forAll $ pure $ fromWord64s ws+    toWord64s ef === (ws :: [Word64])

@@ -4,7 +4,10 @@  import Data.Word import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitShow import HaskellWorks.Data.EliasFano+import HaskellWorks.Data.EliasFano.Internal+import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec@@ -20,9 +23,9 @@ spec = describe "HaskellWorks.Data.EliasFanoSpec" $ do   it "List to EliasFano" $ requireTest $ do     ws <- forAll $ pure $ [2, 3, 5, 7, 11, 13, 24]-    let actual = fromListWord64 ws+    let actual = fromWord64s ws     let expected = EliasFano-          { efBucketBits  = DVS.fromList [4443]+          { efBucketBits  = makeCsPoppy (DVS.fromList [4443])           , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]           , efLoBitCount  = 2           , efCount       = 7@@ -35,12 +38,12 @@     bucketBitsToHiSegment (hiSegmentToBucketBits maxW ws) === ws   it "List to EliasFano" $ requireTest $ do     ws <- forAll $ pure $ EliasFano-          { efBucketBits  = DVS.fromList [4443]+          { efBucketBits  = makeCsPoppy (DVS.fromList [4443])           , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]           , efLoBitCount  = 2           , efCount       = 7           }-    let actual = toListWord64 ws+    let actual = toWord64s ws     let expected = [2, 3, 5, 7, 11, 13, 24]     actual === expected   it "List to EliasFano 2" $ requireTest $ do@@ -61,20 +64,20 @@               , 1446, 1447, 1452, 1477, 1482, 1483, 1486, 1493               , 1498, 1529, 1533, 1534, 1537, 1544, 1549, 1581               ]-    let ef = fromListWord64 ws :: EliasFano+    let ef = fromWord64s ws :: EliasFano     _ <- forAll $ pure ef-    let actual = toListWord64 ef+    let actual = toWord64s ef     let expected = ws     actual === expected   it "Round trip" $ requireProperty $ do     vs <- forAll $ G.list (R.linear 0 100) (G.word64 (R.linear 1 20))     ws <- forAll $ pure $ drop 1 $ scanl (+) 0 vs-    ef :: EliasFano <- forAll $ pure $ fromListWord64 ws-    let actual = toListWord64 ef+    ef :: EliasFano <- forAll $ pure $ fromWord64s ws+    let actual = toWord64s ef     actual === (ws :: [Word64])   it "atIndex" $ requireTest $ do     ef <- forAll $ pure $ EliasFano-          { efBucketBits  = DVS.fromList [4443]+          { efBucketBits  = makeCsPoppy (DVS.fromList [4443])           , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]           , efLoBitCount  = 2           , efCount       = 7@@ -82,3 +85,11 @@     let actual = fmap (atIndex ef) [0 .. end ef - 1]     let expected = [2, 3, 5, 7, 11, 13, 24]     actual === expected+  it "hiSegmentToWords" $ requireTest $ do+    ws <- forAll $ pure $ [1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144]++    filter (/= ' ') (bitShow (hiSegmentToWords ws)) === concat+      [ "01101010", "01000100", "00010000", "00001000", "00000000", "00100000", "00000000", "00000000"+      , "10000000", "00000000", "00000000", "00000000", "00010000", "00000000", "00000000", "00000000"+      , "00000000", "00000000", "00000000", "00010000", "00000000", "00000000", "00000000", "00000000"+      ]