diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2016 John Ky + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# 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) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hw-eliasfano.cabal b/hw-eliasfano.cabal new file mode 100644 --- /dev/null +++ b/hw-eliasfano.cabal @@ -0,0 +1,46 @@ +name: hw-eliasfano +version: 0.0.0.1 +synopsis: Conduits for tokenizing streams. +description: Please see README.md +homepage: http://github.com/haskell-works/hw-eliasfano#readme +license: MIT +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 + +library + hs-source-dirs: src + exposed-modules: HaskellWorks.Data.EliasFano64 + , HaskellWorks.Data.EliasFano64.Internal + build-depends: base >= 4 && < 5 + , hw-bits >= 0.3.0.0 + , hw-prim >= 0.3.0.5 + , safe + , vector + + default-language: Haskell2010 + ghc-options: -Wall -O2 -msse4.2 + +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.3.0.0 + , hw-eliasfano + , hw-prim >= 0.3.0.5 + , QuickCheck + , vector + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/haskell-works/hw-eliasfano diff --git a/src/HaskellWorks/Data/EliasFano64.hs b/src/HaskellWorks/Data/EliasFano64.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/EliasFano64.hs @@ -0,0 +1,64 @@ +{-# 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.Bits.PackedVector as PV +import HaskellWorks.Data.EliasFano64.Internal +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 #-} diff --git a/src/HaskellWorks/Data/EliasFano64/Internal.hs b/src/HaskellWorks/Data/EliasFano64/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/EliasFano64/Internal.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE FlexibleInstances #-} + +module HaskellWorks.Data.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 [] = [] diff --git a/test/HaskellWorks/Data/EliasFano64Spec.hs b/test/HaskellWorks/Data/EliasFano64Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/EliasFano64Spec.hs @@ -0,0 +1,15 @@ +{-# 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]) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}