hw-eliasfano 0.1.0.1 → 0.1.1.0

raw patch · 17 files changed

+691/−176 lines, 17 filesdep +binarydep +bytestringdep +criteriondep −QuickCheckdep −safedep ~hspecdep ~hw-bitsdep ~hw-intnew-component:exe:hw-eliasfanoPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: binary, bytestring, criterion, deepseq, generic-lens, hedgehog, hw-hedgehog, hw-hspec-hedgehog, hw-rankselect, hw-rankselect-base, lens, mmap, optparse-applicative, semigroups

Dependencies removed: QuickCheck, safe

Dependency ranges changed: hspec, hw-bits, hw-int, hw-packed-vector, hw-prim, vector

API changes (from Hackage documentation)

Files

• README.md +2/−1
• app/App/Commands.hs +13/−0
• app/App/Commands/LoadSave.hs +64/−0
• app/App/Commands/Types.hs +13/−0
• app/Main.hs +11/−0
• bench/Main.hs +62/−0
• hw-eliasfano.cabal +128/−43
• src/HaskellWorks/Data/EliasFano.hs +129/−0
• src/HaskellWorks/Data/EliasFano/Internal.hs +8/−0
• src/HaskellWorks/Data/EliasFano64.hs +0/−64
• src/HaskellWorks/Data/EliasFano64/Internal.hs +0/−53
• src/HaskellWorks/Data/FromListWord64.hs +10/−0
• src/HaskellWorks/Data/ToListWord64.hs +8/−0
• test/HaskellWorks/Data/EliasFano/Reference.hs +82/−0
• test/HaskellWorks/Data/EliasFano/ReferenceSpec.hs +77/−0
• test/HaskellWorks/Data/EliasFano64Spec.hs +0/−15
• test/HaskellWorks/Data/EliasFanoSpec.hs +84/−0

@@ -1,2 +1,3 @@ # hw-eliasfano-[![0.0-branch](https://circleci.com/gh/haskell-works/hw-eliasfano/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-eliasfano/tree/0.0-branch)++[![CircleCI](https://circleci.com/gh/haskell-works/hw-eliasfano.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-eliasfano)

@@ -0,0 +1,13 @@+module App.Commands where++import App.Commands.LoadSave+import Data.Semigroup        ((<>))+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+  <>  commandGroup "Commands:"+  <>  cmdLoadSave

@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.LoadSave+  ( cmdLoadSave+  ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Semigroup            ((<>))+import Data.Word+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+import qualified HaskellWorks.Data.PackedVector.PackedVector64 as PV+import qualified System.IO                                     as IO++{-# 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 ws = fmap fromIntegral (decodeWord32s lbs) :: [Word64]+  let ef = EF.fromListWord64 ws :: EF.EliasFano+  -- let x = DVS.length (PV.swBuffer (EF.efCount ef))+  IO.putStrLn $ "Eliasfano:"+    <> " bits: "  <> show (ef & EF.efBucketBits & DVS.length                )+    <> " count: " <> show (ef & EF.efLoSegments & PV.swBuffer & DVS.length  )+    <> " pv: "    <> show (ef & EF.efCount                                  )+    <> " lbc: "   <> show (ef & EF.efLoBitCount                             )++optsLoadSave :: Parser Z.LoadSaveOptions+optsLoadSave = Z.LoadSaveOptions+  <$> 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"+        )++cmdLoadSave :: Mod CommandFields (IO ())+cmdLoadSave = command "load-save"  $ flip info idm $ runLoadSave <$> optsLoadSave

@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Types+  ( LoadSaveOptions(..)+  ) where++import GHC.Generics++data LoadSaveOptions = LoadSaveOptions+  { input  :: FilePath+  , output :: FilePath+  } deriving (Eq, Show, Generic)

@@ -0,0 +1,11 @@+module Main where++import App.Commands+import Control.Monad+import Data.Semigroup      ((<>))+import Options.Applicative++main :: IO ()+main = join $ customExecParser+  (prefs $ showHelpOnEmpty <> showHelpOnError)+  (info (commands <**> helper) idm)

@@ -0,0 +1,62 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Criterion.Main+import Data.Monoid                         ((<>))+import Foreign                             hiding ((.&.))+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.EliasFano+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.PackedVector+import System.Environment+import System.IO.MMap++import qualified Data.ByteString          as BS+import qualified Data.ByteString.Internal as BSI+import qualified Data.Vector.Storable     as DVS++getPositions :: DVS.Vector Word64 -> [Word64]+getPositions v = DVS.ifoldl go id v []+  where go :: ([Word64] -> [Word64]) -> Int -> Word64 -> [Word64] -> [Word64]+        go ws i w = ws . goWord64 id 0 (fromIntegral i * 64) w++goWord64 :: ([Word64] -> [Word64]) -> Word64 -> Word64 -> Word64 -> [Word64] -> [Word64]+goWord64 ws i b w | i < 64  = if (w .&. 1) /= 0 then (b + i:) . goWord64 ws (i + 1) b (w .>. 1) else goWord64 ws (i + 1) b (w .>. 1)+goWord64 ws _ _ _ = ws++encode :: FilePath -> IO ()+encode filename = do+  !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)+  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+  return bs++benchEliasFano :: [Benchmark]+benchEliasFano =+  [ bgroup "Load Elias Fano"+    [ bench "Load Elias Fano"  (whnfIO (encode "larger.ib"))+    ]+  ]++main :: IO ()+main = do+  args <- getArgs++  case args of+    (filename:_) -> encode filename+    _            -> defaultMain benchEliasFano++  putStrLn $ "Arguments: " <> show args

@@ -1,49 +1,134 @@-name:                   hw-eliasfano-version:                0.1.0.1-synopsis:               Elias-Fano-description:            Please see README.md-homepage:               http://github.com/haskell-works/hw-eliasfano#readme-license:                BSD3-license-file:           LICENSE-author:                 John Ky-maintainer:             newhoggy@gmail.com-copyright:              2016 John Ky-category:               Data, Conduit-build-type:             Simple-extra-source-files:     README.md-cabal-version:          >= 1.22+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++source-repository head+  type: git+  location: https://github.com/haskell-works/hw-eliasfano++common base                 { build-depends: base                 >= 4          &&  < 5     }++common bytestring           { build-depends: bytestring           >= 0.10.8.2   && < 0.11   }+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 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-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 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+ library-  hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.EliasFano64-                      , HaskellWorks.Data.EliasFano64.Internal-  build-depends:        base                          >= 4          && < 5-                      , hw-bits                       >= 0.4.0.0-                      , hw-int                        >= 0.0.0.1-                      , hw-packed-vector              >= 0.0.0.1-                      , hw-prim                       >= 0.4.0.0-                      , safe-                      , vector+  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 -  default-language:     Haskell2010-  ghc-options:          -Wall -O2 -msse4.2+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  test-suite hw-eliasfano-test-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-  main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.EliasFano64Spec-  build-depends:        base                          >= 4          && < 5-                      , hspec-                      , hw-bits                       >= 0.4.0.0-                      , hw-eliasfano-                      , hw-int                        >= 0.0.0.1-                      , hw-prim                       >= 0.4.0.0-                      , QuickCheck-                      , vector-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:     Haskell2010+  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 -source-repository head-  type:     git-  location: https://github.com/haskell-works/hw-eliasfano+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

@@ -0,0 +1,129 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}++module HaskellWorks.Data.EliasFano+  ( EliasFano(..)+  , FromListWord64(..)+  , ToListWord64(..)+  , divup+  , hiSegmentToBucketBits+  , bucketBitsToHiSegment+  , 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 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+  , efLoSegments :: !PV.PackedVector64    -- Lower segment of each entry+  , efLoBitCount :: !Count                -- Number of bits in each lower segment+  , efCount      :: !Count                -- Number of entries+  } deriving (Eq, Show, Generic)++instance NFData EliasFano++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++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+      }++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)++instance Container EliasFano where+  type Elem EliasFano = Word64++instance Length EliasFano where+  length = efCount+  {-# INLINE length #-}++instance AtIndex EliasFano where+  (!!!)         = atIndex+  atIndex ef i  = atIndex (efLoSegments ef) i .|. ((select1 (efBucketBits ef) j - j) .<. efLoBitCount ef)+    where j = fromIntegral i + 1+  {-# INLINE (!!!)   #-}+  {-# INLINE atIndex #-}

@@ -0,0 +1,8 @@+module HaskellWorks.Data.EliasFano.Internal+  ( lastMaybe+  ) where++lastMaybe :: [a] -> Maybe a+lastMaybe (a:as@(b:bs)) = lastMaybe as+lastMaybe [a]           = Just a+lastMaybe _             = Nothing

@@ -1,64 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module HaskellWorks.Data.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.EliasFano64.Internal-import           HaskellWorks.Data.PackedVector         as PV-import           HaskellWorks.Data.Positioning-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.EliasFano64.Internal-  ( mkHiBits-  , packToWord8-  , packToWord16-  , packToWord32-  , packToWord64-  ) where--import Data.Word-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Int.Widen-import HaskellWorks.Data.Positioning--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 []       = []

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

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

@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.EliasFano.Reference+  ( EliasFano(..)+  , divup+  , hiSegmentToBucketBits+  , bucketBitsToHiSegment+  ) where++import Data.Bits                            (countLeadingZeros, finiteBitSize)+import Data.Int+import Data.Word+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.ToListWord64+import Prelude                              hiding (length, take)++data EliasFano = EliasFano+  { efBucketBits :: [Bool]   -- 1 marks bucket, 0 marks skip to next+  , efLoSegments :: [Word64] -- Lower segment of each entry+  , efLoBitCount :: Count    -- Number of bits in each lower segment+  , efCount      :: Count    -- Number of entries+  } deriving (Eq, Show)++-- | 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++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++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++-- instance AtIndex EliasFano where+--   (!!!)   v i = v !! fromIntegral i+--   atIndex v i = v !! fromIntegral i+--   {-# INLINE (!!!)   #-}+--   {-# INLINE atIndex #-}

@@ -0,0 +1,77 @@+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.EliasFano.ReferenceSpec (spec) where++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++import qualified Hedgehog.Gen   as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.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 expected = EliasFano+          { efBucketBits  = [ True+                            , True+                            , False+                            , True+                            , True+                            , False+                            , True+                            , False+                            , True+                            , False+                            , False+                            , False+                            , True+                            , False+                            ]+          , efLoSegments  = [2, 3, 1, 3, 3, 1, 0]+          , efLoBitCount  = 2+          , efCount       = 7+          }+    actual === expected+  it "hiSegment <-> bucketBits round trip" $ require $ property $ do+    vs <- forAll $ G.list (R.linear 1 100) (G.word64 (R.linear 0 20))+    ws <- forAll $ pure $ drop 1 $ scanl (+) 0 vs+    maxW <- forAll $ pure $ last ws+    bucketBitsToHiSegment (hiSegmentToBucketBits maxW ws) === ws+  it "List to EliasFano" $ require $ withTests 1 $ property $ do+    ws <- forAll $ pure $ EliasFano+          { efBucketBits  = [ True+                            , True+                            , False+                            , True+                            , True+                            , False+                            , True+                            , False+                            , True+                            , False+                            , False+                            , False+                            , True+                            , False+                            ]+          , efLoSegments  = [2, 3, 1, 3, 3, 1, 0]+          , efLoBitCount  = 2+          , efCount       = 7+          }+    let actual = toListWord64 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])

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

@@ -0,0 +1,84 @@+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.EliasFanoSpec (spec) where++import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.EliasFano+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable                          as DVS+import qualified HaskellWorks.Data.PackedVector.PackedVector64 as PV+import qualified Hedgehog.Gen                                  as G+import qualified Hedgehog.Range                                as R++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.EliasFanoSpec" $ do+  it "List to EliasFano" $ requireTest $ do+    ws <- forAll $ pure $ [2, 3, 5, 7, 11, 13, 24]+    let actual = fromListWord64 ws+    let expected = EliasFano+          { efBucketBits  = DVS.fromList [4443]+          , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]+          , efLoBitCount  = 2+          , efCount       = 7+          }+    actual === expected+  it "hiSegment <-> bucketBits round trip" $ requireProperty $ do+    vs <- forAll $ G.list (R.linear 1 100) (G.word64 (R.linear 0 20))+    ws <- forAll $ pure $ drop 1 $ scanl (+) 0 vs+    maxW <- forAll $ pure $ last ws+    bucketBitsToHiSegment (hiSegmentToBucketBits maxW ws) === ws+  it "List to EliasFano" $ requireTest $ do+    ws <- forAll $ pure $ EliasFano+          { efBucketBits  = DVS.fromList [4443]+          , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]+          , efLoBitCount  = 2+          , efCount       = 7+          }+    let actual = toListWord64 ws+    let expected = [2, 3, 5, 7, 11, 13, 24]+    actual === expected+  it "List to EliasFano 2" $ requireTest $ do+    let ws =  [    0,    5,    6,   14,   20,   29,   39,   51+              ,   52,   60,   64,   71,   76,   87,   97,  103+              ,  122,  135,  233,  245,  657,  662,  663,  671+              ,  676,  684,  690,  701,  709,  725,  734,  755+              ,  783,  796,  834,  841,  842,  845,  855,  861+              ,  883,  888,  910,  917,  925,  936,  945,  962+              ,  982,  998, 1019, 1028, 1029, 1040, 1044, 1048+              , 1057, 1066, 1075, 1080, 1090, 1097, 1098, 1102+              , 1117, 1121, 1136, 1141, 1142, 1148, 1157, 1167+              , 1168, 1173, 1184, 1189, 1201, 1205, 1216, 1225+              , 1226, 1231, 1244, 1249, 1250, 1253, 1257, 1262+              , 1274, 1279, 1280, 1283, 1289, 1294, 1315, 1320+              , 1321, 1324, 1330, 1335, 1346, 1351, 1352, 1355+              , 1362, 1367, 1403, 1414, 1423, 1424, 1427, 1438+              , 1446, 1447, 1452, 1477, 1482, 1483, 1486, 1493+              , 1498, 1529, 1533, 1534, 1537, 1544, 1549, 1581+              ]+    let ef = fromListWord64 ws :: EliasFano+    _ <- forAll $ pure ef+    let actual = toListWord64 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+    actual === (ws :: [Word64])+  it "atIndex" $ requireTest $ do+    ef <- forAll $ pure $ EliasFano+          { efBucketBits  = DVS.fromList [4443]+          , efLoSegments  = PV.fromList 2 [2, 3, 1, 3, 3, 1, 0]+          , efLoBitCount  = 2+          , efCount       = 7+          }+    let actual = fmap (atIndex ef) [0 .. end ef - 1]+    let expected = [2, 3, 5, 7, 11, 13, 24]+    actual === expected