diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ Unbelievably fast streaming DSV file parser that reads based on succinct data structures. -This library will use support for some BMI2 CPU instructions on some x86 based +This library will use support for some BMI2 or AVX2 CPU instructions on some x86 based CPUs if compiled with the appropriate flags on `ghc-8.4.1` or later. ## Compilation @@ -23,15 +23,24 @@ stack bench ``` -For best performance, add the `bmi2` flag to target the BMI2 instruction set: +For best performance, add the `bmi2` and `avx2` flag to target the BMI2 and AVS2 instruction sets: ```text -stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 -stack test --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 -stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 -stack install --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 +stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +stack test --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +stack install --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-simd:avx2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 ``` +For slightly older CPUs, add only the `bmi2` flag to target the BMI2 instruction set: + +```text +stack build --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 +stack test --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 +stack bench --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 +stack install --flag bits-extra:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-simd:bmi2 --flag hw-dsv:bmi2 +``` + ## Benchmark results The following benchmark shows the kinds of performance gain that can @@ -47,12 +56,20 @@ 7.08GiB 0:07:25 [16.3MiB/s] ``` -With BMI2 enabled: +With BMI2 and AVX2 enabled: ```text +$ stack install --flag bits-extra:bmi2 --flag hw-bits:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 --flag hw-dsv:avx2 +$ cat 7gb.csv | pv -t -e -b -a | hw-dsv query-lazy -k 0 -k 1 -d , -e '|' > /dev/null +7.08GiB 0:00:39 [ 181MiB/s] +``` + +With only BMI2 enabled: + +```text $ stack install --flag bits-extra:bmi2 --flag hw-bits:bmi2 --flag hw-rankselect-base:bmi2 --flag hw-rankselect:bmi2 --flag hw-dsv:bmi2 -$ cat 7g.csv | pv -t -e -b -a | hw-dsv query-lazy -k 0 -k 1 -d , -e '|' > /dev/null -7.08GiB 0:00:52 [ 138MiB/s] +$ cat 7gb.csv | pv -t -e -b -a | hw-dsv query-lazy -k 0 -k 1 -d , -e '|' > /dev/null +7.08GiB 0:00:43 [ 165MiB/s] ``` ## Using `hw-dsv` as a library diff --git a/app/App/Commands.hs b/app/App/Commands.hs --- a/app/App/Commands.hs +++ b/app/App/Commands.hs @@ -1,7 +1,8 @@ module App.Commands where -import App.Commands.Cat +import App.Commands.CreateIndex import App.Commands.Generate +import App.Commands.IndexWord8s import App.Commands.QueryLazy import App.Commands.QueryStrict import Data.Semigroup ((<>)) @@ -13,13 +14,13 @@ commandsGeneral :: Parser (IO ()) commandsGeneral = subparser $ mempty <> commandGroup "Commands:" - -- <> cmdCreateIndex + <> cmdCreateIndex <> cmdQueryLazy <> cmdQueryStrict commandsDebugging :: Parser (IO ()) commandsDebugging = subparser $ mempty <> commandGroup "Debugging commands:" - <> cmdCat + <> cmdIndexWord8s <> cmdGenerate <> hidden diff --git a/app/App/Commands/Cat.hs b/app/App/Commands/Cat.hs deleted file mode 100644 --- a/app/App/Commands/Cat.hs +++ /dev/null @@ -1,39 +0,0 @@ -module App.Commands.Cat - ( cmdCat - ) where - -import App.Commands.Options.Type -import Control.Lens -import Data.Semigroup ((<>)) -import Options.Applicative hiding (columns) - -import qualified App.IO as IO -import qualified App.Lens as L -import qualified Data.ByteString.Lazy as LBS - -runCat :: CatOptions -> IO () -runCat opts = do - let source = opts ^. L.source - let target = opts ^. L.target - - contents <- IO.readInputFile source - - LBS.writeFile target contents - - return () - -optsCat :: Parser CatOptions -optsCat = CatOptions - <$> strOption - ( long "input" - <> help "Input file" - <> metavar "FILE" - ) - <*> strOption - ( long "output" - <> help "Output file" - <> metavar "FILE" - ) - -cmdCat :: Mod CommandFields (IO ()) -cmdCat = command "cat" $ flip info idm $ runCat <$> optsCat diff --git a/app/App/Commands/CreateIndex.hs b/app/App/Commands/CreateIndex.hs --- a/app/App/Commands/CreateIndex.hs +++ b/app/App/Commands/CreateIndex.hs @@ -8,15 +8,16 @@ import App.Commands.Options.Type import Control.Lens import Control.Monad -import Data.Semigroup ((<>)) -import Options.Applicative hiding (columns) +import Data.Semigroup ((<>)) +import HaskellWorks.Data.ByteString.Lazy +import Options.Applicative hiding (columns) -import qualified App.IO as IO -import qualified App.Lens as L -import qualified Data.ByteString.Builder as B -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL -import qualified System.IO as IO +import qualified App.IO as IO +import qualified App.Lens as L +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified System.IO as IO runCreateIndex :: CreateIndexOptions -> IO () runCreateIndex opts = do @@ -28,15 +29,19 @@ let !cursor = SVL.makeCursor delimiter bs let !markers = cursor & SVL.dsvCursorMarkers let !newlines = cursor & SVL.dsvCursorNewlines + let !filePathNoDash = if filePath == "-" then "stdin" else filePath - hOutMarkers <- IO.openFile (filePath ++ ".markers.idx") IO.WriteMode - forM_ (markers >>= DVS.toList) $ \w -> do - B.hPutBuilder hOutMarkers (B.word64LE w) + hOutMarkers <- IO.openFile (filePathNoDash ++ ".markers.idx") IO.WriteMode + hOutNewlines <- IO.openFile (filePathNoDash ++ ".newlines.idx") IO.WriteMode + + forM_ (zip markers newlines) $ \(markerV, newlineV) -> do + LBS.hPut hOutMarkers (toLazyByteString markerV) + LBS.hPut hOutNewlines (toLazyByteString newlineV) + + B.hPutBuilder hOutMarkers (B.word8 0xff) -- Telomere byte IO.hClose hOutMarkers - hOutNewlines <- IO.openFile (filePath ++ ".newlines.idx") IO.WriteMode - forM_ (newlines >>= DVS.toList) $ \w -> do - B.hPutBuilder hOutNewlines (B.word64LE w) + B.hPutBuilder hOutNewlines (B.word8 0xff) -- Telomere byte IO.hClose hOutNewlines return () diff --git a/app/App/Commands/Generate.hs b/app/App/Commands/Generate.hs --- a/app/App/Commands/Generate.hs +++ b/app/App/Commands/Generate.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE BangPatterns #-} - module App.Commands.Generate ( cmdGenerate ) where diff --git a/app/App/Commands/IndexWord8s.hs b/app/App/Commands/IndexWord8s.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/IndexWord8s.hs @@ -0,0 +1,66 @@ +module App.Commands.IndexWord8s + ( cmdIndexWord8s + ) where + +import App.Commands.Options.Type +import Control.Lens +import Data.Semigroup ((<>)) +import HaskellWorks.Data.Vector.AsVector64 +import Options.Applicative + +import qualified App.IO as IO +import qualified App.Lens as L +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2 +import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK + +runIndexWord8sNormal :: IndexWord8sOptions -> IO () +runIndexWord8sNormal opts = do + contents <- IO.readInputFile (opts ^. L.source) + + IO.writeOutputFile (opts ^. L.target) $ contents + & LBS.toLazyByteString + . fmap (STOCK.cmpEqWord8s 44 . asVector64) + . BS.resegmentPadded 64 + . LBS.toChunks + +runIndexWord8sSimd :: IndexWord8sOptions -> IO () +runIndexWord8sSimd opts = do + contents <- IO.readInputFile (opts ^. L.source) + + IO.writeOutputFile (opts ^. L.target) $ contents + & LBS.toLazyByteString + . fmap (AVX2.cmpEqWord8s 44 . asVector64) + . BS.resegmentPadded 64 + . LBS.toChunks + +runIndexWord8s :: IndexWord8sOptions -> IO () +runIndexWord8s opts + | opts ^. L.simd = runIndexWord8sSimd opts + | otherwise = runIndexWord8sNormal opts + +optsIndexWord8s :: Parser IndexWord8sOptions +optsIndexWord8s = IndexWord8sOptions + <$> strOption + ( long "input" + <> help "Input file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> strOption + ( long "output" + <> help "Output file" + <> metavar "FILE" + <> showDefault + <> value "-" + ) + <*> switch + ( long "simd" + <> help "Use simd method" + ) + +cmdIndexWord8s :: Mod CommandFields (IO ()) +cmdIndexWord8s = command "index-word8s" $ flip info idm $ runIndexWord8s <$> optsIndexWord8s diff --git a/app/App/Commands/Options/Type.hs b/app/App/Commands/Options/Type.hs --- a/app/App/Commands/Options/Type.hs +++ b/app/App/Commands/Options/Type.hs @@ -13,7 +13,7 @@ , _queryStrictOptionsOutputFilePath :: FilePath , _queryStrictOptionsDelimiter :: Word8 , _queryStrictOptionsOutDelimiter :: Word8 - -- , _queryOptionsUseIndex :: Bool + , _queryStrictOptionsUseIndex :: Bool } deriving (Eq, Show) data GenerateOptions = GenerateOptions @@ -24,12 +24,20 @@ data CatOptions = CatOptions { _catOptionsSource :: FilePath , _catOptionsTarget :: FilePath + , _catOptionsSimd :: Bool } deriving (Eq, Show) +data IndexWord8sOptions = IndexWord8sOptions + { _indexWord8sOptionsSource :: FilePath + , _indexWord8sOptionsTarget :: FilePath + , _indexWord8sOptionsSimd :: Bool + } deriving (Eq, Show) + data QueryLazyOptions = QueryLazyOptions { _queryLazyOptionsColumns :: [Int] , _queryLazyOptionsFilePath :: FilePath , _queryLazyOptionsOutputFilePath :: FilePath , _queryLazyOptionsDelimiter :: Word8 , _queryLazyOptionsOutDelimiter :: Word8 + , _queryLazyOptionsMethod :: String } deriving (Eq, Show) diff --git a/app/App/Commands/QueryLazy.hs b/app/App/Commands/QueryLazy.hs --- a/app/App/Commands/QueryLazy.hs +++ b/app/App/Commands/QueryLazy.hs @@ -19,13 +19,28 @@ import qualified App.IO as IO import qualified App.Lens as L +import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LBS import qualified Data.Vector as DV import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL +import qualified System.Exit as IO +import qualified System.IO as IO +defaultMethod :: String +defaultMethod = "lazy-traverse" + runQueryLazy :: QueryLazyOptions -> IO () -runQueryLazy opts = do +runQueryLazy opts = case opts ^. L.method of + "lazy-traverse" -> runQueryLazyFast opts + "strict-traverse" -> runQueryLazySlow opts + "strict-bytestring" -> runQueryLazyStrict opts + method -> do + IO.hPutStrLn IO.stderr $ "Unknown method: " <> method + IO.exitFailure + +runQueryLazySlow :: QueryLazyOptions -> IO () +runQueryLazySlow opts = do !bs <- IO.readInputFile (opts ^. L.filePath) let !c = SVL.makeCursor (opts ^. L.delimiter) bs @@ -41,12 +56,52 @@ return () return () - where columnToFieldString :: DV.Vector LBS.ByteString -> Int -> B.Builder columnToFieldString fields i = if i >= 0 && i < DV.length fields then B.lazyByteString (DV.unsafeIndex fields i) - else B.lazyByteString (LBS.empty) + else B.lazyByteString LBS.empty +runQueryLazyStrict :: QueryLazyOptions -> IO () +runQueryLazyStrict opts = do + !bs <- IO.readInputFile (opts ^. L.filePath) + + let !c = SVL.makeCursor (opts ^. L.delimiter) bs + let !rows = SVL.toListVectorStrict c + let !outDelimiterBuilder = B.word8 (opts ^. L.outDelimiter) + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. L.outputFilePath) Nothing + forM_ rows $ \row -> do + let fieldStrings = columnToFieldString row <$> (opts ^. L.columns) + + liftIO $ B.hPutBuilder hOut $ mconcat (intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + where columnToFieldString :: DV.Vector BS.ByteString -> Int -> B.Builder + columnToFieldString fields i = if i >= 0 && i < DV.length fields + then B.byteString (DV.unsafeIndex fields i) + else B.byteString BS.empty + +runQueryLazyFast :: QueryLazyOptions -> IO () +runQueryLazyFast opts = do + !bs <- IO.readInputFile (opts ^. L.filePath) + + let !c = SVL.makeCursor (opts ^. L.delimiter) bs + let !sel = opts ^. L.columns + let !rows = SVL.selectListVector sel c + let !outDelimiterBuilder = B.word8 (opts ^. L.outDelimiter) + + runResourceT $ do + (_, hOut) <- IO.openOutputFile (opts ^. L.outputFilePath) Nothing + forM_ rows $ \row -> do + let fieldStrings = fmap B.lazyByteString row + + liftIO $ B.hPutBuilder hOut $ mconcat (intersperse outDelimiterBuilder fieldStrings) <> B.word8 10 + + return () + return () + cmdQueryLazy :: Mod CommandFields (IO ()) cmdQueryLazy = command "query-lazy" $ flip info idm $ runQueryLazy <$> optsQueryLazy @@ -85,4 +140,12 @@ <> short 'e' <> help "Output DSV delimiter" <> metavar "CHAR" + ) + <*> strOption + ( long "method" + <> short 'm' + <> help "Method" + <> metavar "METHOD" + <> showDefault + <> value defaultMethod ) diff --git a/app/App/Commands/QueryStrict.hs b/app/App/Commands/QueryStrict.hs --- a/app/App/Commands/QueryStrict.hs +++ b/app/App/Commands/QueryStrict.hs @@ -28,7 +28,7 @@ runQueryStrict opts = do let delimiter = opts ^. L.delimiter let inputFilePath = opts ^. L.filePath - let useIndex = False -- opts ^. L.useIndex + let useIndex = opts ^. L.useIndex c <- SVS.mmapCursor delimiter useIndex inputFilePath let !rows = SVS.toListVector c @@ -84,4 +84,4 @@ <> help "DSV delimiter to write in the output" <> metavar "CHAR" ) - -- <*> switch (long "use-index") + <*> switch (long "use-index") diff --git a/app/App/IO.hs b/app/App/IO.hs --- a/app/App/IO.hs +++ b/app/App/IO.hs @@ -21,3 +21,7 @@ readInputFile :: FilePath -> IO LBS.ByteString readInputFile "-" = LBS.hGetContents IO.stdin readInputFile filePath = LBS.readFile filePath + +writeOutputFile :: FilePath -> LBS.ByteString -> IO () +writeOutputFile "-" bs = LBS.hPut IO.stdout bs +writeOutputFile filePath bs = LBS.writeFile filePath bs diff --git a/app/App/Lens.hs b/app/App/Lens.hs --- a/app/App/Lens.hs +++ b/app/App/Lens.hs @@ -11,6 +11,7 @@ import Control.Lens makeFields ''CatOptions +makeFields ''IndexWord8sOptions makeFields ''CreateIndexOptions makeFields ''GenerateOptions makeFields ''QueryLazyOptions diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -5,24 +5,24 @@ import Control.Monad import Criterion.Main -import Data.ByteString (ByteString) +import Data.ByteString (ByteString) import Data.List -import Data.Monoid ((<>)) -import Data.Vector (Vector) +import Data.Monoid ((<>)) +import Data.Vector (Vector) import Data.Word +import HaskellWorks.Data.Dsv.Internal.Char (comma, pipe) import System.Directory import qualified Data.ByteString.Lazy as LBS import qualified Data.Csv as CSV import qualified Data.Csv.Streaming as CSS import qualified Data.Vector.Storable as DVS -import HaskellWorks.Data.Dsv.Internal.Char (comma, pipe) import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL -import qualified HaskellWorks.Data.RankSelect.CsPoppy as RS import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal as SVS import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference as SVS import qualified HaskellWorks.Data.FromForeignRegion as IO +import qualified HaskellWorks.Data.RankSelect.CsPoppy as RS loadCassavaStrict :: FilePath -> IO (Vector (Vector ByteString)) loadCassavaStrict filePath = do @@ -99,6 +99,6 @@ main = do benchmarks <- (mconcat <$>) $ sequence $ mempty <> [makeBenchCsv] - <> [makeBenchW64s] - <> [makeBenchMkInterestBits] + -- <> [makeBenchW64s] + -- <> [makeBenchMkInterestBits] defaultMain benchmarks diff --git a/cbits/simd.c b/cbits/simd.c new file mode 100644 --- /dev/null +++ b/cbits/simd.c @@ -0,0 +1,112 @@ +#include "simd.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +typedef uint8_t v32si __attribute__ ((vector_size (32))); +typedef uint8_t v16si __attribute__ ((vector_size (16))); + +void print_bits_16(uint16_t word) { + size_t i; + + putc('|', stdout); + + for (i = 0; i < 16; ++i) { + putc((word & (1L << i)) ? '1' : '0', stdout); + } + printf("|\n"); +} + +void system_memcpy( + char *target, + char *source, + size_t len) { + memcpy(target, source, len); +} + +void avx2_memcpy( + uint8_t *target, + uint8_t *source, + size_t len) { +#if defined(AVX2_ENABLED) + size_t aligned_len = (len / 32) * 32; + size_t remaining_len = len - aligned_len; + + size_t i; + + for (i = 0; i < aligned_len; i += 32) { + __m128i v0 = *(__m128i*)(source + i ); + __m128i v1 = *(__m128i*)(source + i + 16); + + *(__m128i*)(target + i ) = v0; + *(__m128i*)(target + i + 16 ) = v1; + } + + memcpy(target + aligned_len, source + aligned_len, remaining_len); +#endif +} + + +void sse_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source) { + uint16_t *target16 = (uint16_t *)target; + + __m128i v_comparand = _mm_set1_epi8(byte); + + uint16_t *out_mask = (uint16_t*)target; + size_t i; + + for (i = 0; i < target_length * 4; ++i) { + __m128i v_data_a = *(__m128i*)(source + (i * 16)); + __m128i v_results_a = _mm_cmpeq_epi8(v_data_a, v_comparand); + uint16_t mask = (uint16_t)_mm_movemask_epi8(v_results_a); + target16[i] = mask; + } +} + +void avx2_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source) { +#if defined(AVX2_ENABLED) + uint32_t *target32 = (uint32_t *)target; + + __m256 v_comparand = _mm256_set1_epi8(byte); + + uint32_t *out_mask = (uint32_t*)target; + + size_t i; + + for (i = 0; i < target_length * 2; ++i) { + __m256 v_data_a = *(__m256*)(source + (i * 32)); + __m256 v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand); + uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a); + target32[i] = mask; + } +#endif +} + +int example_main() { + uint8_t source[32] = "01234567890123456789012345678901"; + uint8_t target[33]; + avx2_memcpy(target, source, 32); + target[32] = 0; + printf("%s\n", target); + + // uint8_t source2[64] = "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"; + // uint64_t target2[1] = {0}; + // avx2_cmpeq8('0', target2, 1, source2); + // printf("%llu\n", target2[0]); + + return 0; +} diff --git a/cbits/simd.h b/cbits/simd.h new file mode 100644 --- /dev/null +++ b/cbits/simd.h @@ -0,0 +1,13 @@ +#include +#include + +void avx2_memcpy( + uint8_t *target, + uint8_t *source, + size_t len); + +void avx2_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source); diff --git a/hw-dsv.cabal b/hw-dsv.cabal --- a/hw-dsv.cabal +++ b/hw-dsv.cabal @@ -1,14 +1,12 @@ --- This file has been generated from package.yaml by hpack version 0.27.0. +-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack --- --- hash: 14ef3831452c80f0f1a586d2faec53d18ae39348940e4b1a47bc7dcb4d302e23 name: hw-dsv -version: 0.2.1 +version: 0.3.0 synopsis: Unbelievably fast streaming DSV file parser description: Please see the README on Github at -category: Text, Web, CSV +category: Text, CSV, SIMD, Succinct Data Structures, Data Structures homepage: https://github.com/haskell-works/hw-dsv#readme bug-reports: https://github.com/haskell-works/hw-dsv/issues author: John Ky @@ -21,6 +19,7 @@ cabal-version: >= 1.10 extra-source-files: + cbits/simd.h ChangeLog.md data/bench/data-0001000.csv README.md @@ -29,6 +28,11 @@ type: git location: https://github.com/haskell-works/hw-dsv +flag avx2 + description: Enable avx2 instruction set + manual: False + default: False + flag bmi2 description: Enable bmi2 instruction set manual: False @@ -40,11 +44,51 @@ default: True library + hs-source-dirs: + src + ghc-options: -O2 -Wall + include-dirs: + cbits + c-sources: + cbits/simd.c + build-depends: + base >= 4.7 && < 5 + , bits-extra >= 0.0.1.2 && < 0.1 + , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4 && < 1.5 + , ghc-prim + , hw-bits >= 0.7.0.2 && < 0.8 + , hw-rankselect >= 0.12.0.2 && < 0.13 + , hw-rankselect-base >= 0.3.2.0 && < 0.4 + , hw-prim >= 0.6.2.14 && < 0.7 + , hw-simd >= 0.1.1.2 && < 0.2 + , vector >= 0.12.0.1 && < 0.13 + build-tools: + c2hs + if flag(sse42) + ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED + if (flag(bmi2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED + if (impl(ghc >=8.0.1)) + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + if (!impl(ghc >=8.0.1)) + build-depends: + transformers >= 0.4 && < 0.6 + , semigroups >= 0.8.4 && < 0.19 exposed-modules: HaskellWorks.Data.Dsv.Internal.Bits HaskellWorks.Data.Dsv.Internal.Broadword HaskellWorks.Data.Dsv.Internal.Char HaskellWorks.Data.Dsv.Internal.Char.Word64 + HaskellWorks.Data.Dsv.Internal.Vector HaskellWorks.Data.Dsv.Lazy.Cursor HaskellWorks.Data.Dsv.Lazy.Cursor.Internal HaskellWorks.Data.Dsv.Lazy.Cursor.Type @@ -54,183 +98,192 @@ HaskellWorks.Data.Dsv.Strict.Cursor.Type other-modules: Paths_hw_dsv + default-language: Haskell2010 + +executable hw-dsv + main-is: Main.hs hs-source-dirs: - src - ghc-options: -O2 -Wall + app + ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 - , bits-extra >=0.0.1.2 && <0.1 - , bytestring >=0.10 && <0.11 - , deepseq >=1.4 && <1.5 - , hw-bits >=0.7.0.2 && <0.8 - , hw-prim >=0.6.2.0 && <0.7 - , hw-rankselect >=0.12.0.2 && <0.13 - , hw-rankselect-base >=0.3.2.0 && <0.4 - , vector >=0.12.0.1 && <0.13 + base >= 4.7 && < 5 + , bits-extra >= 0.0.1.2 && < 0.1 + , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4 && < 1.5 + , ghc-prim + , hw-bits >= 0.7.0.2 && < 0.8 + , hw-rankselect >= 0.12.0.2 && < 0.13 + , hw-rankselect-base >= 0.3.2.0 && < 0.4 + , hw-prim >= 0.6.2.14 && < 0.7 + , hw-simd >= 0.1.1.2 && < 0.2 + , vector >= 0.12.0.1 && < 0.13 + , hw-dsv + , hedgehog >= 0.5 && < 0.7 + , lens >= 4.15 && < 5 + , optparse-applicative >= 0.13 && < 0.15 + , resourcet >= 1.1 && < 1.3 if flag(sse42) ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED if (flag(bmi2)) && (impl(ghc >=8.4.1)) ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED if (impl(ghc >=8.0.1)) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints if (!impl(ghc >=8.0.1)) build-depends: - semigroups >=0.8.4 && <0.19 - , transformers >=0.4 && <0.6 - default-language: Haskell2010 - -executable hw-dsv - main-is: Main.hs + transformers >= 0.4 && < 0.6 + , semigroups >= 0.8.4 && < 0.19 other-modules: App.Char App.Commands - App.Commands.Cat App.Commands.CreateIndex App.Commands.Generate + App.Commands.IndexWord8s App.Commands.Options.Type App.Commands.QueryLazy App.Commands.QueryStrict App.Gen App.IO App.Lens - Paths_hw_dsv - hs-source-dirs: - app - ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N - build-depends: - base >=4.7 && <5 - , bits-extra >=0.0.1.2 && <0.1 - , bytestring >=0.10 && <0.11 - , deepseq >=1.4 && <1.5 - , hedgehog >=0.5 && <0.7 - , hw-bits >=0.7.0.2 && <0.8 - , hw-dsv - , hw-prim >=0.6.2.0 && <0.7 - , hw-rankselect >=0.12.0.2 && <0.13 - , hw-rankselect-base >=0.3.2.0 && <0.4 - , lens >=4.15 && <5 - , optparse-applicative >=0.13 && <0.15 - , resourcet >=1.1 && <1.3 - , vector >=0.12.0.1 && <0.13 - if flag(sse42) - ghc-options: -msse4.2 - if (flag(bmi2)) && (impl(ghc >=8.4.1)) - ghc-options: -mbmi2 -msse4.2 - if (impl(ghc >=8.0.1)) - ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints - if (!impl(ghc >=8.0.1)) - build-depends: - semigroups >=0.8.4 && <0.19 - , transformers >=0.4 && <0.6 default-language: Haskell2010 test-suite hw-dsv-space type: exitcode-stdio-1.0 main-is: Space.hs - other-modules: - Paths_hw_dsv hs-source-dirs: weigh ghc-options: -O2 -Wall build-depends: - base >=4.7 && <5 - , bits-extra >=0.0.1.2 && <0.1 - , bytestring >=0.10 && <0.11 - , cassava >=0.5.1.0 && <0.6 - , deepseq >=1.4 && <1.5 - , hw-bits >=0.7.0.2 && <0.8 + base >= 4.7 && < 5 + , bits-extra >= 0.0.1.2 && < 0.1 + , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4 && < 1.5 + , ghc-prim + , hw-bits >= 0.7.0.2 && < 0.8 + , hw-rankselect >= 0.12.0.2 && < 0.13 + , hw-rankselect-base >= 0.3.2.0 && < 0.4 + , hw-prim >= 0.6.2.14 && < 0.7 + , hw-simd >= 0.1.1.2 && < 0.2 + , vector >= 0.12.0.1 && < 0.13 + , cassava >= 0.5.1.0 && < 0.6 , hw-dsv - , hw-prim >=0.6.2.0 && <0.7 - , hw-rankselect >=0.12.0.2 && <0.13 - , hw-rankselect-base >=0.3.2.0 && <0.4 - , vector >=0.12.0.1 && <0.13 - , weigh >=0.0.6 && <0.1 + , weigh >= 0.0.6 && < 0.1 if flag(sse42) ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED if (flag(bmi2)) && (impl(ghc >=8.4.1)) ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED if (impl(ghc >=8.0.1)) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints if (!impl(ghc >=8.0.1)) build-depends: - semigroups >=0.8.4 && <0.19 - , transformers >=0.4 && <0.6 + transformers >= 0.4 && < 0.6 + , semigroups >= 0.8.4 && < 0.19 default-language: Haskell2010 - build-tool-depends: hspec-discover:hspec-discover test-suite hw-dsv-test type: exitcode-stdio-1.0 main-is: Spec.hs - other-modules: - HaskellWorks.Data.Dsv.BroadwordSpec - HaskellWorks.Data.Dsv.Gen - HaskellWorks.Data.Dsv.Lazy.CursorSpec - HaskellWorks.Data.Dsv.Strict.Cursor.InternalSpec - HaskellWorks.Data.DsvSpec - Paths_hw_dsv hs-source-dirs: test ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 - , bits-extra >=0.0.1.2 && <0.1 - , bytestring >=0.10 && <0.11 - , deepseq >=1.4 && <1.5 - , directory >=1.2.2 && <1.4 - , hedgehog >=0.5 && <0.7 - , hspec >=2.4 && <3 - , hw-bits >=0.7.0.2 && <0.8 + base >= 4.7 && < 5 + , bits-extra >= 0.0.1.2 && < 0.1 + , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4 && < 1.5 + , ghc-prim + , hw-bits >= 0.7.0.2 && < 0.8 + , hw-rankselect >= 0.12.0.2 && < 0.13 + , hw-rankselect-base >= 0.3.2.0 && < 0.4 + , hw-prim >= 0.6.2.14 && < 0.7 + , hw-simd >= 0.1.1.2 && < 0.2 + , vector >= 0.12.0.1 && < 0.13 + , directory >= 1.2.2 && < 1.4 , hw-dsv - , hw-hspec-hedgehog >=0.1.0.4 && <0.2 - , hw-prim >=0.6.2.0 && <0.7 - , hw-rankselect >=0.12.0.2 && <0.13 - , hw-rankselect-base >=0.3.2.0 && <0.4 - , text >=1.2.2 && <2.0 - , vector >=0.12.0.1 && <0.13 + , hedgehog >= 0.5 && < 0.7 + , hspec >= 2.4 && < 3 + , hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 + , text >= 1.2.2 && < 2.0 if flag(sse42) ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED if (flag(bmi2)) && (impl(ghc >=8.4.1)) ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED if (impl(ghc >=8.0.1)) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints if (!impl(ghc >=8.0.1)) build-depends: - semigroups >=0.8.4 && <0.19 - , transformers >=0.4 && <0.6 + transformers >= 0.4 && < 0.6 + , semigroups >= 0.8.4 && < 0.19 + other-modules: + HaskellWorks.Data.Dsv.BroadwordSpec + HaskellWorks.Data.Dsv.Gen + HaskellWorks.Data.Dsv.Lazy.CursorSpec + HaskellWorks.Data.Dsv.Strict.Cursor.InternalSpec + HaskellWorks.Data.DsvSpec default-language: Haskell2010 - build-tool-depends: hspec-discover:hspec-discover benchmark bench type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: - Paths_hw_dsv hs-source-dirs: bench ghc-options: -O2 -Wall -msse4.2 build-depends: - base >=4.7 && <5 - , bits-extra >=0.0.1.2 && <0.1 - , bytestring >=0.10 && <0.11 - , cassava >=0.5.1.0 && <0.6 - , criterion >=1.4.1.0 && <1.5 - , deepseq >=1.4 && <1.5 - , directory >=1.3.1.5 && <1.4 - , hw-bits >=0.7.0.2 && <0.8 + base >= 4.7 && < 5 + , bits-extra >= 0.0.1.2 && < 0.1 + , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4 && < 1.5 + , ghc-prim + , hw-bits >= 0.7.0.2 && < 0.8 + , hw-rankselect >= 0.12.0.2 && < 0.13 + , hw-rankselect-base >= 0.3.2.0 && < 0.4 + , hw-prim >= 0.6.2.14 && < 0.7 + , hw-simd >= 0.1.1.2 && < 0.2 + , vector >= 0.12.0.1 && < 0.13 + , cassava >= 0.5.1.0 && < 0.6 + , criterion >= 1.4.1.0 && < 1.6 + , directory >= 1.3.1.5 && < 1.4 , hw-dsv - , hw-prim >=0.6.2.0 && <0.7 - , hw-rankselect >=0.12.0.2 && <0.13 - , hw-rankselect-base >=0.3.2.0 && <0.4 - , mmap >=0.5.9 && <0.6 - , vector >=0.12.0.1 && <0.13 + , mmap >= 0.5.9 && < 0.6 if flag(sse42) ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED if (flag(bmi2)) && (impl(ghc >=8.4.1)) ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED if (impl(ghc >=8.0.1)) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints if (!impl(ghc >=8.0.1)) build-depends: - semigroups >=0.8.4 && <0.19 - , transformers >=0.4 && <0.6 + transformers >= 0.4 && < 0.6 + , semigroups >= 0.8.4 && < 0.19 default-language: Haskell2010 diff --git a/src/HaskellWorks/Data/Dsv/Internal/Vector.hs b/src/HaskellWorks/Data/Dsv/Internal/Vector.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Dsv/Internal/Vector.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.Dsv.Internal.Vector where + +import Control.Monad.ST +import Data.Bits.Pdep +import Data.Word +import Foreign.Storable (Storable) +import GHC.Int +import GHC.Prim +import GHC.Word hiding (ltWord) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Positioning + +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Storable.Mutable as DVSM + +constructNS :: forall a s. Storable a => Int -> s -> (s -> DVS.Vector a -> (s, a)) -> (s, DVS.Vector a) +constructNS n s f = DVS.createT (go 0 s) + where go :: forall q. Int -> s -> ST q (s, DVS.MVector q a) + go n1 s1 = do + mv :: DVS.MVector q a <- DVSM.unsafeNew n + u <- DVS.unsafeFreeze mv + let (s2, w) = f s1 (DVS.take n1 u) + DVSM.unsafeWrite mv n1 w + return (s2, mv) +{-# INLINE constructNS #-} + +ltWord :: Word64 -> Word64 -> Word64 +ltWord (W64# a#) (W64# b#) = fromIntegral (I64# (ltWord# a# b#)) +{-# INLINE ltWord #-} + +indexCsvChunk :: + Count + -> Word64 + -> DVS.Vector Word64 + -> DVS.Vector Word64 + -> DVS.Vector Word64 + -> (DVS.Vector Word64, DVS.Vector Word64, Word64, Word64) +indexCsvChunk qqCount qqCarry mks nls qqs = runST $ do + tmks <- DVSM.unsafeNew len + tnls <- DVSM.unsafeNew len + (newCount, newCarry) <- go 0 qqCount qqCarry tmks tnls + rmks <- DVS.unsafeFreeze tmks + rnls <- DVS.unsafeFreeze tnls + return (rmks, rnls, newCount, newCarry) + where len = DVS.length mks + go :: Int -> Word64 -> Word64 -> DVSM.MVector z Word64 -> DVSM.MVector z Word64 -> ST z (Count, Word64) + go i pc carry tmks tnls | i < len = do + let qq = DVS.unsafeIndex qqs i + let mk = DVS.unsafeIndex mks i + let nl = DVS.unsafeIndex nls i + + let enters = pdep (oddsMask .<. (0x1 .&. pc)) qq + let leaves = pdep (oddsMask .<. (0x1 .&. comp pc)) qq + + let compLeaves = comp leaves + let preQuoteMask = enters + compLeaves + let quoteMask = preQuoteMask + carry + let newCarry = preQuoteMask `ltWord` enters + + DVSM.unsafeWrite tmks i ((nl .|. mk) .&. quoteMask) + DVSM.unsafeWrite tnls i ( nl .&. quoteMask) + + go (i + 1) (popCount1 qq + pc) newCarry tmks tnls + go _ pc carry _ _ = return (pc, carry) +{-# INLINE indexCsvChunk #-} + +oddsMask :: Word64 +oddsMask = 0x5555555555555555 +{-# INLINE oddsMask #-} diff --git a/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs b/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs --- a/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs +++ b/src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs @@ -5,28 +5,42 @@ , trim , atEnd , nextField + , advanceField , nextRow , nextPosition - , getRowBetween , toListVector , toVectorVector + , selectListVector + , getRowBetweenStrict + , toListVectorStrict ) where import Data.Function -import GHC.Word (Word8) -import HaskellWorks.Data.Dsv.Internal.Broadword (fillWord64) -import HaskellWorks.Data.Dsv.Internal.Bits -import HaskellWorks.Data.Dsv.Lazy.Cursor.Internal +import Data.Word +import GHC.Word (Word8) import HaskellWorks.Data.Dsv.Lazy.Cursor.Type +import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.Vector.AsVector64s import Prelude -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Vector as DV -import qualified HaskellWorks.Data.Dsv.Internal.Char.Word64 as CW +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Dsv.Internal.Char as C +import qualified HaskellWorks.Data.Dsv.Internal.Vector as DVS +import qualified HaskellWorks.Data.Simd.Comparison as DVS +makeIndexes :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] -> ([DVS.Vector Word64], [DVS.Vector Word64]) +makeIndexes ds ns qs = unzip $ go 0 0 ds ns qs + where go pc carry (dv:dvs) (nv:nvs) (qv:qvs) = + let (dv', nv', pc', carry') = DVS.indexCsvChunk pc carry dv nv qv in + (dv', nv'):go pc' carry' dvs nvs qvs + go _ _ [] [] [] = [] + go _ _ _ _ _ = error "Unbalanced inputs" + makeCursor :: Word8 -> LBS.ByteString -> DsvCursor makeCursor delimiter lbs = DsvCursor { dsvCursorText = lbs @@ -35,14 +49,10 @@ , dsvCursorPosition = 0 } where ws = asVector64s 64 lbs - ibq = makeIbs CW.doubleQuote <$> ws - ibn = makeIbs CW.newline <$> ws - ibd = makeIbs (fillWord64 delimiter) <$> ws - pcq = makeCummulativePopCount ibq - ibr = zip2Or ibn ibd - qm = makeQuoteMask ibq pcq - ib = zip2And ibr qm - nls = zip2And ibn qm + ibq = DVS.cmpEqWord8s C.doubleQuote <$> ws + ibn = DVS.cmpEqWord8s C.newline <$> ws + ibd = DVS.cmpEqWord8s delimiter <$> ws + (ib, nls) = makeIndexes ibd ibn ibq {-# INLINE makeCursor #-} snippet :: DsvCursor -> LBS.ByteString @@ -76,6 +86,14 @@ newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) - 1 {-# INLINE nextField #-} +advanceField :: Count -> DsvCursor -> DsvCursor +advanceField n cursor = cursor + { dsvCursorPosition = newPos + } + where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor) + newPos = select1 (dsvCursorMarkers cursor) (currentRank + n) - 1 +{-# INLINE advanceField #-} + nextRow :: DsvCursor -> DsvCursor nextRow cursor = cursor { dsvCursorPosition = if newPos > dsvCursorPosition cursor @@ -122,3 +140,55 @@ toVectorVector :: DsvCursor -> DV.Vector (DV.Vector LBS.ByteString) toVectorVector = DV.fromList . toListVector {-# INLINE toVectorVector #-} + +selectRowFrom :: [Int] -> DsvCursor -> [LBS.ByteString] +selectRowFrom sel c = go <$> sel + where go :: Int -> LBS.ByteString + go n = snippet nc + where nc = nextPosition (advanceField (fromIntegral n) c) + {-# INLINE go #-} +{-# INLINE selectRowFrom #-} + +selectListVector :: [Int] -> DsvCursor -> [[LBS.ByteString]] +selectListVector sel c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then selectRowFrom sel c:selectListVector sel (trim d) + else [] + where nr = nextRow c + d = nextPosition nr +{-# INLINE selectListVector #-} + +getRowBetweenStrict :: DsvCursor -> DsvCursor -> Bool -> DV.Vector BS.ByteString +getRowBetweenStrict c d dEnd = DV.unfoldrN fields go c + where bsA = fromIntegral $ dsvCursorPosition c + bsZ = fromIntegral $ dsvCursorPosition d + bsT = dsvCursorText c + bs = LBS.toStrict $ LBS.take (bsZ - bsA) (LBS.drop bsA bsT) + + cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c) + dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d) + c2d = fromIntegral (dr - cr) + fields = if dEnd then c2d +1 else c2d + go :: DsvCursor -> Maybe (BS.ByteString, DsvCursor) + go e = case nextField e of + f -> case nextPosition f of + g -> case snippetStrict e (fromIntegral bsA) bs of + s -> Just (s, g) + {-# INLINE go #-} +{-# INLINE getRowBetweenStrict #-} + +snippetStrict :: DsvCursor -> Int -> BS.ByteString -> BS.ByteString +snippetStrict c offset bs = BS.take (len `max` 0) $ BS.drop posC $ bs + where d = nextField c + posC = fromIntegral (dsvCursorPosition c) - offset + posD = fromIntegral (dsvCursorPosition d) - offset + len = posD - posC +{-# INLINE snippetStrict #-} + +toListVectorStrict :: DsvCursor -> [DV.Vector BS.ByteString] +toListVectorStrict c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c) + then getRowBetweenStrict c d dEnd:toListVectorStrict (trim d) + else [] + where nr = nextRow c + d = nextPosition nr + dEnd = atEnd nr +{-# INLINE toListVectorStrict #-} diff --git a/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs b/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs --- a/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs +++ b/src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs @@ -2,65 +2,19 @@ {-# LANGUAGE FlexibleContexts #-} module HaskellWorks.Data.Dsv.Lazy.Cursor.Internal - ( makeIbs - , makeCummulativePopCount + ( makeCummulativePopCount , makeQuoteMask ) where import Data.Word import HaskellWorks.Data.AtIndex -import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.Dsv.Internal.Bits import HaskellWorks.Data.Dsv.Internal.Broadword import Prelude import qualified Data.Vector.Storable as DVS {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} - -makeIbs :: Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 -makeIbs iw v = DVS.constructN ((DVS.length v + 7) `div` 8) go - where go :: DVS.Vector Word64 -> Word64 - go u = let ui = end u in - if ui * 8 + 8 < end v - then let vi = ui * 8 - w0 = testWord8s ((v !!! (vi + 0)) .^. iw) - w1 = testWord8s ((v !!! (vi + 1)) .^. iw) - w2 = testWord8s ((v !!! (vi + 2)) .^. iw) - w3 = testWord8s ((v !!! (vi + 3)) .^. iw) - w4 = testWord8s ((v !!! (vi + 4)) .^. iw) - w5 = testWord8s ((v !!! (vi + 5)) .^. iw) - w6 = testWord8s ((v !!! (vi + 6)) .^. iw) - w7 = testWord8s ((v !!! (vi + 7)) .^. iw) - w = (w7 .<. 56) .|. - (w6 .<. 48) .|. - (w5 .<. 40) .|. - (w4 .<. 32) .|. - (w3 .<. 24) .|. - (w2 .<. 16) .|. - (w1 .<. 8) .|. - w0 - in comp w - else let vi = ui * 8 - w0 = testWord8s (atIndexOr 0 v (vi + 0) .^. iw) - w1 = testWord8s (atIndexOr 0 v (vi + 1) .^. iw) - w2 = testWord8s (atIndexOr 0 v (vi + 2) .^. iw) - w3 = testWord8s (atIndexOr 0 v (vi + 3) .^. iw) - w4 = testWord8s (atIndexOr 0 v (vi + 4) .^. iw) - w5 = testWord8s (atIndexOr 0 v (vi + 5) .^. iw) - w6 = testWord8s (atIndexOr 0 v (vi + 6) .^. iw) - w7 = testWord8s (atIndexOr 0 v (vi + 7) .^. iw) - w = (w7 .<. 56) .|. - (w6 .<. 48) .|. - (w5 .<. 40) .|. - (w4 .<. 32) .|. - (w3 .<. 24) .|. - (w2 .<. 16) .|. - (w1 .<. 8) .|. - w0 - in comp w -{-# INLINE makeIbs #-} makeQuoteMask1 :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 makeQuoteMask1 ibv pcv = DVS.constructN (DVS.length ibv) go diff --git a/src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs b/src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs --- a/src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs +++ b/src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} module HaskellWorks.Data.Dsv.Strict.Cursor.Type ( DsvCursor(..) diff --git a/test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs b/test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs --- a/test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs +++ b/test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs @@ -11,6 +11,7 @@ import Data.List (isSuffixOf) import Data.Monoid ((<>)) import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Dsv.Internal.Char (pipe) import HaskellWorks.Data.FromByteString import HaskellWorks.Hspec.Hedgehog import Hedgehog @@ -20,7 +21,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vector.Storable as DVS -import HaskellWorks.Data.Dsv.Internal.Char (comma, pipe) import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal as SVS import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference as SVS import qualified HaskellWorks.Data.FromForeignRegion as IO @@ -64,10 +64,8 @@ it "Case 5" $ requireTest $ do bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 10000) (G.element " \"") v <- forAll $ pure $ fromByteString bs - numQuotes <- forAll $ pure $ BS.length $ BS.filter (== fromIntegral (ord '"')) bs u <- forAll $ pure $ fst $ SVS.makeIndexes pipe v let !expected = SVS.mkIbVector pipe v - let !pc = DVS.foldr (\a b -> popCount1 a + b) 0 u u === expected it "Case 6" $ requireTest $ do entries <- liftIO $ IO.listDirectory "data/bench" diff --git a/test/HaskellWorks/Data/DsvSpec.hs b/test/HaskellWorks/Data/DsvSpec.hs --- a/test/HaskellWorks/Data/DsvSpec.hs +++ b/test/HaskellWorks/Data/DsvSpec.hs @@ -4,15 +4,13 @@ module HaskellWorks.Data.DsvSpec (spec) where -import Data.Word -import HaskellWorks.Data.Bits.BitRead import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Dsv.Internal.Char (comma) import HaskellWorks.Data.FromByteString import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec -import HaskellWorks.Data.Dsv.Internal.Char (comma) import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference as SVS {-# ANN module ("HLint: ignore Redundant do" :: String) #-} @@ -26,11 +24,6 @@ \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\ \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\ \12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz" - let Just (expected :: [Word64]) = bitRead - "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ - \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ - \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ - \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" let v = fromByteString bs let actual = SVS.mkIbVector comma v @@ -44,11 +37,6 @@ \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\ \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\ \12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"" - let Just (expected :: [Word64]) = bitRead - "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ - \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ - \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ - \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" let v = fromByteString bs let !actual = SVS.mkIbVector comma v @@ -62,11 +50,6 @@ \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\ \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\ \12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"" - let Just (expected :: [Word64]) = bitRead - "00000000 10000000 01000000 10000000 00000000 00000000 00010000 00001000 \ - \00000100 00001000 00000000 00000000 00000001 00000000 10000000 01000000 \ - \10000000 00000000 00000000 00010000 00001000 00000100 00001000 00000000 \ - \00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" let v = fromByteString bs let !actual = SVS.mkIbVector comma v