hw-dsv (empty) → 0.1.0.0
raw patch · 35 files changed
+1986/−0 lines, 35 filesdep +basedep +bits-extradep +bytestringsetup-changed
Dependencies added: base, bits-extra, bytestring, cassava, criterion, directory, hedgehog, hspec, hw-bits, hw-dsv, hw-hspec-hedgehog, hw-prim, hw-rankselect, hw-rankselect-base, lens, mmap, optparse-applicative, resourcet, text, vector, weigh
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +76/−0
- Setup.hs +2/−0
- app/App/Char.hs +23/−0
- app/App/Commands.hs +25/−0
- app/App/Commands/Cat.hs +39/−0
- app/App/Commands/CreateIndex.hs +61/−0
- app/App/Commands/Generate.hs +50/−0
- app/App/Commands/Options/Type.hs +33/−0
- app/App/Commands/QueryLazy.hs +89/−0
- app/App/Commands/QueryStrict.hs +88/−0
- app/App/Gen.hs +9/−0
- app/App/IO.hs +23/−0
- app/App/Lens.hs +17/−0
- app/Main.hs +11/−0
- bench/Main.hs +115/−0
- hw-dsv.cabal +196/−0
- src/HaskellWorks/Data/Dsv/Internal/Bits.hs +49/−0
- src/HaskellWorks/Data/Dsv/Internal/Broadword.hs +18/−0
- src/HaskellWorks/Data/Dsv/Internal/Char.hs +16/−0
- src/HaskellWorks/Data/Dsv/Internal/Char/Word64.hs +22/−0
- src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs +120/−0
- src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs +92/−0
- src/HaskellWorks/Data/Dsv/Lazy/Cursor/Type.hs +14/−0
- src/HaskellWorks/Data/Dsv/Strict/Cursor.hs +109/−0
- src/HaskellWorks/Data/Dsv/Strict/Cursor/Internal.hs +134/−0
- src/HaskellWorks/Data/Dsv/Strict/Cursor/Internal/Reference.hs +224/−0
- src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs +20/−0
- test/HaskellWorks/Data/Dsv/BroadwordSpec.hs +58/−0
- test/HaskellWorks/Data/Dsv/Gen.hs +10/−0
- test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs +88/−0
- test/HaskellWorks/Data/DsvSpec.hs +81/−0
- test/Spec.hs +1/−0
- weigh/Space.hs +40/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hw-dsv++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of John Ky nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,76 @@+# hw-dsv+[](https://circleci.com/gh/haskell-works/hw-dsv)+[](https://travis-ci.org/haskell-works/hw-dsv)++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+CPUs if compiled with the appropriate flags on `ghc-8.4.1` or later.++## Compilation++Pre-requisites:++* Install [Haskell Stack](https://docs.haskellstack.org/en/stable/README/)++It is sufficient to build, test and benchmark the library as follows+for basic performance. The library will be compiled to use broadword+implementation of rank & select, which has reasonable performance.++```text+stack build+stack test+stack bench+```++For best perform, add 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-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+```++## Benchmark results++The following benchmark shows the kinds of performance gain that can+be expected from enabling the BMI2 instruction set for CPU targets+that support them. Benchmarks were run on 2.9 GHz Intel Core i7,+macOS High Sierra.++With BMI2 disabled:++```text+$ stack install+$ cat 7g.csv | pv -t -e -b -a | hw-dsv query-lazy -k 0 -k 1 -d , -e '|' > /dev/null+7.08GiB 0:07:25 [16.3MiB/s]+```++With 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]+```++## Using `hw-dsv` as a library++```haskell+{-# LANGUAGE ScopedTypeVariables #-}++module Example where++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector as DV+import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL++example :: IO ()+example = do+ bs <- LBS.readFile "sample.csv"+ let c = SVL.makeCursor ',' bs+ let rows :: [DV.Vector LBS.ByteString] = SVL.toListVector c++ return ()+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App/Char.hs view
@@ -0,0 +1,23 @@+module App.Char where++import Data.Char+import Data.Semigroup ((<>))+import Data.Word+import Options.Applicative (ReadM, eitherReader)++doubleQuote :: Word8+doubleQuote = fromIntegral (ord '"')++comma :: Word8+comma = fromIntegral (ord ',')++pipe :: Word8+pipe = fromIntegral (ord '|')++newline :: Word8+newline = fromIntegral (ord '\n')++readChar :: ReadM Char+readChar = eitherReader $ \xs -> case xs of+ [a] -> return a+ _ -> Left $ "Invalid delimeter " <> show xs
+ app/App/Commands.hs view
@@ -0,0 +1,25 @@+module App.Commands where++import App.Commands.Cat+import App.Commands.Generate+import App.Commands.QueryLazy+import App.Commands.QueryStrict+import Data.Semigroup ((<>))+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral <|> commandsDebugging++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+ <> commandGroup "Commands:"+ -- <> cmdCreateIndex+ <> cmdQueryLazy+ <> cmdQueryStrict++commandsDebugging :: Parser (IO ())+commandsDebugging = subparser $ mempty+ <> commandGroup "Debugging commands:"+ <> cmdCat+ <> cmdGenerate+ <> hidden
+ app/App/Commands/Cat.hs view
@@ -0,0 +1,39 @@+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
+ app/App/Commands/CreateIndex.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns #-}++module App.Commands.CreateIndex+ ( cmdCreateIndex+ ) where++import App.Char+import App.Commands.Options.Type+import Control.Lens+import Control.Monad+import Data.Semigroup ((<>))+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 HaskellWorks.Data.Dsv.Lazy.Cursor.Type as SVL+import qualified System.IO as IO++runCreateIndex :: CreateIndexOptions -> IO ()+runCreateIndex opts = do+ let !filePath = opts ^. L.filePath+ let !delimiter = opts ^. L.delimiter++ !bs <- IO.readInputFile filePath++ let !cursor = SVL.makeCursor delimiter bs+ let !markers = cursor & SVL.dsvCursorMarkers+ let !newlines = cursor & SVL.dsvCursorNewlines++ hOutMarkers <- IO.openFile (filePath ++ ".markers.idx") IO.WriteMode+ forM_ (markers >>= DVS.toList) $ \w -> do+ B.hPutBuilder hOutMarkers (B.word64LE w)+ IO.hClose hOutMarkers++ hOutNewlines <- IO.openFile (filePath ++ ".newlines.idx") IO.WriteMode+ forM_ (newlines >>= DVS.toList) $ \w -> do+ B.hPutBuilder hOutNewlines (B.word64LE w)+ IO.hClose hOutNewlines++ return ()++optsCreateIndex :: Parser CreateIndexOptions+optsCreateIndex = CreateIndexOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input DSV file"+ <> metavar "STRING"+ )+ <*> option readChar+ ( long "input-delimiter"+ <> short 'd'+ <> help "DSV delimiter"+ <> metavar "CHAR"+ )++cmdCreateIndex :: Mod CommandFields (IO ())+cmdCreateIndex = command "create-index" $ flip info idm $ runCreateIndex <$> optsCreateIndex
+ app/App/Commands/Generate.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++module App.Commands.Generate+ ( cmdGenerate+ ) where++import App.Commands.Options.Type+import Control.Lens+import Data.List+import Data.Semigroup ((<>))+import Options.Applicative hiding (columns)++import qualified App.Gen as G+import qualified App.Lens as L+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++printField :: String -> String+printField cs = if any invalid cs+ then escape cs+ else cs+ where invalid c = c == ',' || c == '\r' || c == '\n' || c == '"'+ escape = ("\"" <>) . (<> "\"") . concatMap (\c -> if c == '"' then "\"\"" else [c])++runGenerate :: GenerateOptions -> IO ()+runGenerate opts = do+ let fields = opts ^. L.fields+ let rows = opts ^. L.rows++ csv <- G.sample (G.list (R.singleton rows) (G.list (R.singleton fields) (G.field))) :: IO [[String]]++ putStr $ unlines $ map (intercalate "," . map printField) csv++ return ()++optsGenerate :: Parser GenerateOptions+optsGenerate = GenerateOptions+ <$> option auto+ ( long "fields"+ <> help "Number of fields"+ <> metavar "INT"+ )+ <*> option auto+ ( long "rows"+ <> help "Number of rows"+ <> metavar "INT"+ )++cmdGenerate :: Mod CommandFields (IO ())+cmdGenerate = command "generate" $ flip info idm $ runGenerate <$> optsGenerate
+ app/App/Commands/Options/Type.hs view
@@ -0,0 +1,33 @@+module App.Commands.Options.Type where++data CreateIndexOptions = CreateIndexOptions+ { _createIndexOptionsFilePath :: FilePath+ , _createIndexOptionsDelimiter :: Char+ } deriving (Eq, Show)++data QueryStrictOptions = QueryStrictOptions+ { _queryStrictOptionsColumns :: [Int]+ , _queryStrictOptionsFilePath :: FilePath+ , _queryStrictOptionsOutputFilePath :: FilePath+ , _queryStrictOptionsDelimiter :: Char+ , _queryStrictOptionsOutDelimiter :: Char+ -- , _queryOptionsUseIndex :: Bool+ } deriving (Eq, Show)++data GenerateOptions = GenerateOptions+ { _generateOptionsFields :: Int+ , _generateOptionsRows :: Int+ } deriving (Eq, Show)++data CatOptions = CatOptions+ { _catOptionsSource :: FilePath+ , _catOptionsTarget :: FilePath+ } deriving (Eq, Show)++data QueryLazyOptions = QueryLazyOptions+ { _queryLazyOptionsColumns :: [Int]+ , _queryLazyOptionsFilePath :: FilePath+ , _queryLazyOptionsOutputFilePath :: FilePath+ , _queryLazyOptionsDelimiter :: Char+ , _queryLazyOptionsOutDelimiter :: Char+ } deriving (Eq, Show)
+ app/App/Commands/QueryLazy.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.QueryLazy+ ( cmdQueryLazy+ ) where++import App.Char+import App.Commands.Options.Type+import Control.Applicative+import Control.Lens+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource+import Data.Char+import Data.List+import Data.Semigroup ((<>))+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.ByteString.Lazy as LBS+import qualified Data.Vector as DV+import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL++runQueryLazy :: QueryLazyOptions -> IO ()+runQueryLazy opts = do+ !bs <- IO.readInputFile (opts ^. L.filePath)++ let !c = SVL.makeCursor (opts ^. L.delimiter) bs+ let !rows = SVL.toListVector c+ let !outDelimiterBuilder = B.word8 (fromIntegral (ord (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 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)++cmdQueryLazy :: Mod CommandFields (IO ())+cmdQueryLazy = command "query-lazy" $ flip info idm $ runQueryLazy <$> optsQueryLazy++optsQueryLazy :: Parser QueryLazyOptions+optsQueryLazy = QueryLazyOptions+ <$> many+ ( option auto+ ( long "column"+ <> short 'k'+ <> help "Column to select"+ <> metavar "COLUMN INDEX" ))+ <*> strOption+ ( long "input"+ <> short 'i'+ <> help "Input DSV file"+ <> metavar "FILE"+ <> showDefault+ <> value "-"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output DSV file"+ <> metavar "FILE"+ <> showDefault+ <> value "-"+ )+ <*> option readChar+ ( long "input-delimiter"+ <> short 'd'+ <> help "Input DSV delimiter"+ <> metavar "CHAR"+ )+ <*> option readChar+ ( long "output-delimiter"+ <> short 'e'+ <> help "Output DSV delimiter"+ <> metavar "CHAR"+ )
+ app/App/Commands/QueryStrict.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.QueryStrict+ ( cmdQueryStrict+ ) where++import App.Char+import App.Commands.Options.Type+import Control.Applicative+import Control.Lens+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource+import Data.Char (ord)+import Data.List+import Data.Semigroup ((<>))+import Options.Applicative++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.Vector as DV+import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS++runQueryStrict :: QueryStrictOptions -> IO ()+runQueryStrict opts = do+ let delimiter = opts ^. L.delimiter+ let inputFilePath = opts ^. L.filePath+ let useIndex = False -- opts ^. L.useIndex+ c <- SVS.mmapCursor delimiter useIndex inputFilePath++ let !rows = SVS.toListVector c+ let !outDelimiterBuilder = B.word8 (fromIntegral (ord (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++cmdQueryStrict :: Mod CommandFields (IO ())+cmdQueryStrict = command "query-strict" $ flip info idm $ runQueryStrict <$> optsQueryStrict++optsQueryStrict :: Parser QueryStrictOptions+optsQueryStrict = QueryStrictOptions+ <$> many+ ( option auto+ ( long "column"+ <> short 'k'+ <> help "Column to select"+ <> metavar "COLUMN INDEX" ))+ <*> strOption+ ( long "input"+ <> short 'i'+ <> help "Input DSV file"+ <> metavar "FILE"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output DSV file"+ <> metavar "FILE"+ )+ <*> option readChar+ ( long "input-delimiter"+ <> short 'd'+ <> help "DSV delimiter to read in the input"+ <> metavar "CHAR"+ )+ <*> option readChar+ ( long "output-delimiter"+ <> short 'e'+ <> help "DSV delimiter to write in the output"+ <> metavar "CHAR"+ )+ -- <*> switch (long "use-index")
+ app/App/Gen.hs view
@@ -0,0 +1,9 @@+module App.Gen where++import Hedgehog++import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++field :: MonadGen m => m String+field = G.string (R.linear 0 20) (G.choice [G.alphaNum, G.element "\r\n,\" \t"])
+ app/App/IO.hs view
@@ -0,0 +1,23 @@+module App.IO where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import System.IO (Handle)++import qualified Data.ByteString.Lazy as LBS+import qualified System.IO as IO++openOutputFile :: MonadResource m => FilePath -> Maybe Int -> m (ReleaseKey, Handle)+openOutputFile "-" _ = allocate (return IO.stdout) (const (return ()))+openOutputFile filePath maybeBufferSize = allocate open close+ where open = do+ handle <- IO.openFile filePath IO.WriteMode+ forM_ maybeBufferSize $ \bufferSize ->+ liftIO $ IO.hSetBuffering handle (IO.BlockBuffering (Just bufferSize))+ return handle+ close = IO.hClose++readInputFile :: FilePath -> IO LBS.ByteString+readInputFile "-" = LBS.hGetContents IO.stdin+readInputFile filePath = LBS.readFile filePath
+ app/App/Lens.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}++module App.Lens where++import App.Commands.Options.Type+import Control.Lens++makeFields ''CatOptions+makeFields ''CreateIndexOptions+makeFields ''GenerateOptions+makeFields ''QueryLazyOptions+makeFields ''QueryStrictOptions
+ app/Main.hs view
@@ -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)
+ bench/Main.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Monad+import Criterion.Main+import Data.ByteString (ByteString)+import Data.List+import Data.Monoid+import Data.Vector (Vector)+import Data.Word+import Foreign+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Dsv.Internal.Char.Word64+import HaskellWorks.Data.FromByteString+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Product+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.CsPoppy+import System.Directory+import Weigh++import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Csv as CSV+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Internal.Char.Word64 as C+import qualified HaskellWorks.Data.Dsv.Lazy.Cursor as SVL+import qualified HaskellWorks.Data.Dsv.Lazy.Cursor.Type as SVL+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 System.IO as IO+import qualified System.IO.MMap as IO++loadCassava :: FilePath -> IO (Vector (Vector ByteString))+loadCassava filePath = do+ r <- fmap (CSV.decode CSV.HasHeader) (LBS.readFile filePath) :: IO (Either String (Vector (Vector ByteString)))+ case r of+ Left _ -> error "Unexpected parse error"+ Right v -> pure v++loadHwsvStrictIndex :: FilePath -> IO (Vector (Vector ByteString))+loadHwsvStrictIndex filePath = do+ !c <- SVS.mmapCursor ',' True filePath++ return DV.empty++loadHwsvStrict :: FilePath -> IO (Vector (Vector ByteString))+loadHwsvStrict filePath = SVS.toVectorVector <$> SVS.mmapCursor ',' True filePath++loadHwsvLazyIndex :: FilePath -> IO (Vector (Vector ByteString))+loadHwsvLazyIndex filePath = do+ !bs <- LBS.readFile filePath++ let c = SVL.makeCursor ',' bs+ let zipIndexes = zip (SVL.dsvCursorMarkers c) (SVL.dsvCursorNewlines c)+ let !n = length zipIndexes++ return DV.empty++loadHwsvLazy :: FilePath -> IO (Vector (Vector LBS.ByteString))+loadHwsvLazy filePath = do+ !bs <- LBS.readFile filePath++ let c = SVL.makeCursor ',' bs++ return (SVL.toVectorVector c)++makeBenchCsv :: IO [Benchmark]+makeBenchCsv = do+ entries <- listDirectory "data/bench"+ let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+ benchmarks <- forM files $ \file -> return $ mempty+ <> [bench ("cassava/decode/" <> file) (nfIO (loadCassava file))]+ <> [bench ("hw-dsv/decode/via-strict/" <> file) (nfIO (loadHwsvStrict file))]+ <> [bench ("hw-dsv/decode/via-lazy/" <> file) (nfIO (loadHwsvLazy file))]++ <> [bench ("hw-dsv/decode/via-strict/index/" <> file) (nfIO (loadHwsvStrictIndex file))]+ <> [bench ("hw-dsv/decode/via-lazy/index/" <> file) (nfIO (loadHwsvLazyIndex file))]+ return (join benchmarks)++makeBenchW64s :: IO [Benchmark]+makeBenchW64s = do+ entries <- listDirectory "data/bench"+ let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+ benchmarks <- forM files $ \file -> return+ [ env (IO.mmapFromForeignRegion file) $ \v -> bgroup "Creating bit index from mmaped file" $ mempty+ <> [bench ("mkIbVector with sum" <> file) (whnf (DVS.foldl (+) 0 . SVS.mkIbVector ',') v)]+ ]+ return (join benchmarks)++makeBenchMkInterestBits :: IO [Benchmark]+makeBenchMkInterestBits = do+ entries <- listDirectory "data/bench"+ let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+ benchmarks <- forM files $ \file -> return+ [ env (IO.mmapFromForeignRegion file) $ \(v :: DVS.Vector Word64) -> bgroup "Loading lazy byte string into Word64s" $ mempty+ <> [bench ("mkIbVector with sum" <> file) (whnf (DVS.foldr (+) 0 . SVS.mkIbVector '|') v)]+ <> [bench ("makeIndexes with sum" <> file) (whnf (DVS.foldr (+) 0 . fst . SVS.makeIndexes '|') v)]+ ]+ return (join benchmarks)++main :: IO ()+main = do+ benchmarks <- (mconcat <$>) $ sequence $ mempty+ <> [makeBenchCsv]+ <> [makeBenchW64s]+ <> [makeBenchMkInterestBits]+ defaultMain benchmarks
+ hw-dsv.cabal view
@@ -0,0 +1,196 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2b55c1593dd8ee6761e1e2410a91aefd9181377f288885778372a2956c520fc9++name: hw-dsv+version: 0.1.0.0+description: Please see the README on Github at <https://github.com/newhoggy/hw-dsv#readme>+homepage: https://github.com/haskell-works/hw-dsv#readme+bug-reports: https://github.com/haskell-works/hw-dsv/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2018 John Ky+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-dsv++flag bmi2+ description: Enable bmi2 instruction set+ manual: False+ default: False++flag sse42+ description: Enable SSE 4.2 optimisations.+ manual: False+ default: True++library+ 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.Lazy.Cursor+ HaskellWorks.Data.Dsv.Lazy.Cursor.Internal+ HaskellWorks.Data.Dsv.Lazy.Cursor.Type+ HaskellWorks.Data.Dsv.Strict.Cursor+ HaskellWorks.Data.Dsv.Strict.Cursor.Internal+ HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference+ HaskellWorks.Data.Dsv.Strict.Cursor.Type+ other-modules:+ Paths_hw_dsv+ hs-source-dirs:+ src+ ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10.8.2 && <0.11+ , 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+ if flag(sse42)+ ghc-options: -msse4.2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ default-language: Haskell2010++executable hw-dsv+ main-is: Main.hs+ other-modules:+ App.Char+ App.Commands+ App.Commands.Cat+ App.Commands.CreateIndex+ App.Commands.Generate+ 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 -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10.8.2 && <0.11+ , hedgehog >=0.6 && <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.16.1 && <5+ , optparse-applicative >=0.14.2.0 && <0.15+ , resourcet >=1.2.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+ 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.8.2 && <0.11+ , cassava >=0.5.1.0 && <0.6+ , 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+ , vector >=0.12.0.1 && <0.13+ , weigh >=0.0.11 && <0.1+ if flag(sse42)+ ghc-options: -msse4.2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ 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.Strict.Cursor.InternalSpec+ HaskellWorks.Data.DsvSpec+ Paths_hw_dsv+ hs-source-dirs:+ test+ ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10.8.2 && <0.11+ , directory >=1.3.1.5 && <1.4+ , hedgehog >=0.6 && <0.7+ , hspec >=2.5.1 && <3+ , hw-bits >=0.7.0.2 && <0.8+ , 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.3.0 && <2.0+ , 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+ 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 -msse4.2+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10.8.2 && <0.11+ , cassava >=0.5.1.0 && <0.6+ , criterion >=1.4.1.0 && <1.5+ , directory >=1.3.1.5 && <1.4+ , 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+ , mmap >=0.5.9 && <0.6+ , vector >=0.12.0.1 && <0.13+ , weigh >=0.0.11 && <0.1+ if flag(sse42)+ ghc-options: -msse4.2+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ default-language: Haskell2010
+ src/HaskellWorks/Data/Dsv/Internal/Bits.hs view
@@ -0,0 +1,49 @@+module HaskellWorks.Data.Dsv.Internal.Bits where++import Data.Bits.Pext+import Data.Word+import HaskellWorks.Data.Bits.BitWise++import qualified Data.Vector.Storable as DVS++testWord8s :: Word64 -> Word64+testWord8s w = let w8s = w+ w4s = w8s .|. (w8s .>. 4)+ w2s = w4s .|. (w4s .>. 2)+ w1s = w2s .|. (w2s .>. 1)+ in pext w1s 0x0101010101010101+{-# INLINE testWord8s #-}++zipOr :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+zipOr as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go+ where go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = DVS.length u+ in if ui < DVS.length as && ui < DVS.length bs+ then DVS.unsafeIndex as ui .|. DVS.unsafeIndex bs ui+ else error "Different sized vectors"+{-# INLINE zipOr #-}++zip2Or :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64]+zip2Or (a:as) (b:bs) = zipOr a b:zip2Or as bs+zip2Or (a:as) [] = a:zip2Or as []+zip2Or [] (b:bs) = b:zip2Or [] bs+zip2Or [] [] = []+{-# INLINE zip2Or #-}++zipAnd :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+zipAnd as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go+ where go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = DVS.length u+ in if ui < DVS.length as && ui < DVS.length bs+ then DVS.unsafeIndex as ui .&. DVS.unsafeIndex bs ui+ else error "Different sized vectors"+{-# INLINE zipAnd #-}++zip2And :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64]+zip2And (a:as) (b:bs) = zipAnd a b:zip2And as bs+zip2And (a:as) [] = a:zip2And as []+zip2And [] (b:bs) = b:zip2And [] bs+zip2And [] [] = []+{-# INLINE zip2And #-}
+ src/HaskellWorks/Data/Dsv/Internal/Broadword.hs view
@@ -0,0 +1,18 @@+module HaskellWorks.Data.Dsv.Internal.Broadword where++import Data.Bits.Pdep+import Data.Word+import HaskellWorks.Data.Bits.BitWise++class FillWord64 a where+ fillWord64 :: a -> Word64++instance FillWord64 Word8 where+ fillWord64 w = 0x0101010101010101 * fromIntegral w+ {-# INLINE fillWord64 #-}++toggle64 :: Word64 -> Word64 -> Word64+toggle64 carry w =+ let c = carry .&. 0x1+ in let addend = pdep (0x5555555555555555 .<. c) w+ in ((addend .<. 1) .|. c) + comp w
+ src/HaskellWorks/Data/Dsv/Internal/Char.hs view
@@ -0,0 +1,16 @@+module HaskellWorks.Data.Dsv.Internal.Char where++import Data.Char+import Data.Word++doubleQuote :: Word8+doubleQuote = fromIntegral (ord '"')++comma :: Word8+comma = fromIntegral (ord ',')++pipe :: Word8+pipe = fromIntegral (ord '|')++newline :: Word8+newline = fromIntegral (ord '\n')
+ src/HaskellWorks/Data/Dsv/Internal/Char/Word64.hs view
@@ -0,0 +1,22 @@+module HaskellWorks.Data.Dsv.Internal.Char.Word64 where++import Data.Char+import Data.Word+import HaskellWorks.Data.Dsv.Internal.Broadword++import qualified HaskellWorks.Data.Dsv.Internal.Char as C++doubleQuote :: Word64+doubleQuote = 0x0101010101010101 * fromIntegral C.doubleQuote++comma :: Word64+comma = 0x0101010101010101 * fromIntegral C.comma++pipe :: Word64+pipe = 0x0101010101010101 * fromIntegral C.pipe++newline :: Word64+newline = 0x0101010101010101 * fromIntegral C.newline++fillWord64WithChar8 :: Char -> Word64+fillWord64WithChar8 c = fillWord64 (fromIntegral (ord c) :: Word8)
+ src/HaskellWorks/Data/Dsv/Lazy/Cursor.hs view
@@ -0,0 +1,120 @@+module HaskellWorks.Data.Dsv.Lazy.Cursor+ ( makeCursor+ , snippet+ , trim+ , atEnd+ , nextField+ , nextRow+ , nextPosition+ , getRowBetween+ , toListVector+ , toVectorVector+ ) where++import Data.Char (ord)+import Data.Function+import HaskellWorks.Data.Dsv.Internal.Bits+import HaskellWorks.Data.Dsv.Lazy.Cursor.Internal+import HaskellWorks.Data.Dsv.Lazy.Cursor.Type+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++makeCursor :: Char -> LBS.ByteString -> DsvCursor+makeCursor delimiter lbs = DsvCursor+ { dsvCursorDelimiter = fromIntegral (ord delimiter)+ , dsvCursorText = lbs+ , dsvCursorMarkers = ib+ , dsvCursorNewlines = nls+ , dsvCursorPosition = 0+ }+ where ws = asVector64s 64 lbs+ ibq = makeIbs CW.doubleQuote <$> ws+ ibn = makeIbs CW.newline <$> ws+ ibd = makeIbs (CW.fillWord64WithChar8 delimiter) <$> ws+ pcq = makeCummulativePopCount ibq+ ibr = zip2Or ibn ibd+ qm = makeQuoteMask ibq pcq+ ib = zip2And ibr qm+ nls = zip2And ibn qm+{-# INLINE makeCursor #-}++snippet :: DsvCursor -> LBS.ByteString+snippet c = LBS.take (len `max` 0) $ LBS.drop posC $ dsvCursorText c+ where d = nextField c+ posC = fromIntegral $ dsvCursorPosition c+ posD = fromIntegral $ dsvCursorPosition d+ len = posD - posC+{-# INLINE snippet #-}++trim :: DsvCursor -> DsvCursor+trim c = if dsvCursorPosition c >= 512+ then trim c+ { dsvCursorText = LBS.drop 512 (dsvCursorText c)+ , dsvCursorMarkers = drop 1 (dsvCursorMarkers c)+ , dsvCursorNewlines = drop 1 (dsvCursorNewlines c)+ , dsvCursorPosition = dsvCursorPosition c - 512+ }+ else c+{-# INLINE trim #-}++atEnd :: DsvCursor -> Bool+atEnd c = LBS.null (LBS.drop (fromIntegral (dsvCursorPosition c)) (dsvCursorText c))+{-# INLINE atEnd #-}++nextField :: DsvCursor -> DsvCursor+nextField cursor = cursor+ { dsvCursorPosition = newPos+ }+ where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) - 1+{-# INLINE nextField #-}++nextRow :: DsvCursor -> DsvCursor+nextRow cursor = cursor+ { dsvCursorPosition = if newPos > dsvCursorPosition cursor+ then newPos+ else fromIntegral (LBS.length (dsvCursorText cursor))++ }+ where currentRank = rank1 (dsvCursorNewlines cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorNewlines cursor) (currentRank + 1) - 1+{-# INLINE nextRow #-}++nextPosition :: DsvCursor -> DsvCursor+nextPosition cursor = cursor+ { dsvCursorPosition = if LBS.null (LBS.drop (fromIntegral newPos) (dsvCursorText cursor))+ then fromIntegral (LBS.length (dsvCursorText cursor))+ else newPos+ }+ where newPos = dsvCursorPosition cursor + 1+{-# INLINE nextPosition #-}++getRowBetween :: DsvCursor -> DsvCursor -> DV.Vector LBS.ByteString+getRowBetween c d = DV.unfoldrN c2d go c+ where cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c)+ dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d)+ c2d = fromIntegral (dr - cr)+ go :: DsvCursor -> Maybe (LBS.ByteString, DsvCursor)+ go e = case nextField e of+ f -> case nextPosition f of+ g -> case snippet e of+ s -> Just (s, g)+ {-# INLINE go #-}+{-# INLINE getRowBetween #-}++toListVector :: DsvCursor -> [DV.Vector LBS.ByteString]+toListVector c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c)+ then getRowBetween c d:toListVector (trim d)+ else []+ where d = nextPosition (nextRow c)+{-# INLINE toListVector #-}++toVectorVector :: DsvCursor -> DV.Vector (DV.Vector LBS.ByteString)+toVectorVector = DV.fromList . toListVector+{-# INLINE toVectorVector #-}
+ src/HaskellWorks/Data/Dsv/Lazy/Cursor/Internal.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}++module HaskellWorks.Data.Dsv.Lazy.Cursor.Internal+ ( makeIbs+ , 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+ where go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = end u in+ toggle64 (pcv !!! ui) (ibv !!! ui)+{-# INLINE makeQuoteMask1 #-}++makeQuoteMask :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64]+makeQuoteMask (ibv:ibvs) (pcv:pcvs) = makeQuoteMask1 ibv pcv:makeQuoteMask ibvs pcvs+makeQuoteMask _ _ = []+{-# INLINE makeQuoteMask #-}++makeCummulativePopCount2 :: Word64 -> DVS.Vector Word64 -> (DVS.Vector Word64, Word64)+makeCummulativePopCount2 c v = let r = DVS.constructN (DVS.length v + 1) go in (DVS.unsafeInit r, DVS.unsafeLast r)+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = end u in+ if ui > 0+ then popCount1 (v !!! (ui - 1)) + (u !!! (ui - 1))+ else c+{-# INLINE makeCummulativePopCount2 #-}++makeCummulativePopCount :: [DVS.Vector Word64] -> [DVS.Vector Word64]+makeCummulativePopCount = go 0+ where go :: Word64 -> [DVS.Vector Word64] -> [DVS.Vector Word64]+ go c (v:vs) = let (u, c') = makeCummulativePopCount2 c v in u:go c' vs+ go _ [] = []+{-# INLINE makeCummulativePopCount #-}
+ src/HaskellWorks/Data/Dsv/Lazy/Cursor/Type.hs view
@@ -0,0 +1,14 @@+module HaskellWorks.Data.Dsv.Lazy.Cursor.Type where++import Data.Word++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS++data DsvCursor = DsvCursor+ { dsvCursorDelimiter :: Word8+ , dsvCursorText :: !LBS.ByteString+ , dsvCursorMarkers :: ![DVS.Vector Word64]+ , dsvCursorNewlines :: ![DVS.Vector Word64]+ , dsvCursorPosition :: !Word64+ } deriving (Eq, Show)
+ src/HaskellWorks/Data/Dsv/Strict/Cursor.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dsv.Strict.Cursor+ ( DsvCursor(..)+ , snippet+ , nextField+ , nextPosition+ , nextRow+ , mmapCursor+ , toListVector+ , toVectorVector+ ) where++import Data.Char (ord)+import Data.Word+import HaskellWorks.Data.Dsv.Strict.Cursor.Type+import HaskellWorks.Data.Product+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.CsPoppy++import qualified Data.ByteString as BS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal as SVS+import qualified HaskellWorks.Data.FromForeignRegion as IO++mmapCursor :: Char -> Bool -> FilePath -> IO (DsvCursor BS.ByteString CsPoppy)+mmapCursor delimiter useIndex filePath = do+ (!bs) :*: (!v) <- IO.mmapFromForeignRegion filePath+ let !_ = v :: DVS.Vector Word64+ (!markers, !newlines) <- if useIndex+ then (,)+ <$> IO.mmapFromForeignRegion (filePath ++ ".markers.idx")+ <*> IO.mmapFromForeignRegion (filePath ++ ".newlines.idx")+ else return $ SVS.makeIndexes delimiter v+ return DsvCursor+ { dsvCursorDelimiter = fromIntegral (ord delimiter)+ , dsvCursorText = bs+ , dsvCursorMarkers = makeCsPoppy markers+ , dsvCursorNewlines = makeCsPoppy newlines+ , dsvCursorPosition = 0+ }++snippet :: DsvCursor BS.ByteString CsPoppy -> BS.ByteString+snippet c = BS.take (len `max` 0) $ BS.drop posC $ dsvCursorText c+ where d = nextField c+ posC = fromIntegral $ dsvCursorPosition c+ posD = fromIntegral $ dsvCursorPosition d+ len = posD - posC+{-# INLINE snippet #-}++atEnd :: DsvCursor BS.ByteString CsPoppy -> Bool+atEnd c = BS.null (BS.drop (fromIntegral (dsvCursorPosition c)) (dsvCursorText c))+{-# INLINE atEnd #-}++nextField :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy+nextField cursor = cursor+ { dsvCursorPosition = newPos+ }+ where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1) - 1+{-# INLINE nextField #-}++nextRow :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy+nextRow cursor = cursor+ { dsvCursorPosition = if newPos > dsvCursorPosition cursor+ then newPos+ else fromIntegral (BS.length (dsvCursorText cursor))++ }+ where currentRank = rank1 (dsvCursorNewlines cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorNewlines cursor) (currentRank + 1) - 1+{-# INLINE nextRow #-}++nextPosition :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy+nextPosition cursor = cursor+ { dsvCursorPosition = if BS.null (BS.drop (fromIntegral newPos) (dsvCursorText cursor))+ then fromIntegral (BS.length (dsvCursorText cursor))+ else newPos+ }+ where newPos = dsvCursorPosition cursor + 1+{-# INLINE nextPosition #-}++getRowBetween :: DsvCursor BS.ByteString CsPoppy -> DsvCursor BS.ByteString CsPoppy -> DV.Vector BS.ByteString+getRowBetween c d = DV.unfoldrN c2d go c+ where cr = rank1 (dsvCursorMarkers c) (dsvCursorPosition c)+ dr = rank1 (dsvCursorMarkers d) (dsvCursorPosition d)+ c2d = fromIntegral (dr - cr)+ go :: DsvCursor BS.ByteString CsPoppy -> Maybe (BS.ByteString, DsvCursor BS.ByteString CsPoppy)+ go e = case nextField e of+ f -> case nextPosition f of+ g -> case snippet e of+ s -> Just (s, g)+ {-# INLINE go #-}+{-# INLINE getRowBetween #-}++toListVector :: DsvCursor BS.ByteString CsPoppy -> [DV.Vector BS.ByteString]+toListVector c = if dsvCursorPosition d > dsvCursorPosition c && not (atEnd c)+ then getRowBetween c d:toListVector d+ else []+ where d = nextPosition (nextRow c)+{-# INLINE toListVector #-}++toVectorVector :: DsvCursor BS.ByteString CsPoppy -> DV.Vector (DV.Vector BS.ByteString)+toVectorVector = DV.fromList . toListVector+{-# INLINE toVectorVector #-}
+ src/HaskellWorks/Data/Dsv/Strict/Cursor/Internal.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dsv.Strict.Cursor.Internal where++import Control.Monad.ST+import Data.Bits (popCount)+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Dsv.Internal.Bits+import HaskellWorks.Data.Dsv.Internal.Broadword+import HaskellWorks.Data.Dsv.Internal.Char.Word64+import HaskellWorks.Data.Dsv.Strict.Cursor.Type+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude++import qualified Data.Vector.Storable as DVS+import qualified Data.Vector.Storable.Mutable as DVSM+import qualified HaskellWorks.Data.Dsv.Internal.Char.Word64 as CW++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++makeIndexes :: Char -> DVS.Vector Word64 -> (DVS.Vector Word64, DVS.Vector Word64)+makeIndexes delimiter ws = case DVS.createT $ makeIndexes' CW.doubleQuote CW.newline (fillWord64WithChar8 delimiter) ws of+ [markers, newlines] -> (markers, newlines)+ _ -> error "This should not happen"++makeIndexes' :: forall s.+ Word64+ -> Word64+ -> Word64+ -> DVS.Vector Word64+ -> ST s [DVS.MVector s Word64]+makeIndexes' rdqs rnls rdls ws = do+ (markers :: DVSM.MVector s Word64) <- DVSM.unsafeNew ((DVS.length ws + 7) `div` 8)+ (newlines :: DVSM.MVector s Word64) <- DVSM.unsafeNew ((DVS.length ws + 7) `div` 8)+ go markers newlines 0 0+ return [markers, newlines]+ where go :: DVSM.MVector s Word64 -> DVSM.MVector s Word64 -> Position -> Count -> ST s ()+ go markers newlines wsi numQuotes = let ui = wsi `div` 8 in if wsi >= 0 && wsi + 8 <= end ws+ then do+ let w0 = ws !!! wsi+ let w0Dqs = testWord8s (w0 .^. rdqs)+ let w0Nls = testWord8s (w0 .^. rnls)+ let w0Dls = testWord8s (w0 .^. rdls)+ let w1 = ws !!! (wsi + 1)+ let w1Dqs = testWord8s (w1 .^. rdqs)+ let w1Nls = testWord8s (w1 .^. rnls)+ let w1Dls = testWord8s (w1 .^. rdls)+ let w2 = ws !!! (wsi + 2)+ let w2Dqs = testWord8s (w2 .^. rdqs)+ let w2Nls = testWord8s (w2 .^. rnls)+ let w2Dls = testWord8s (w2 .^. rdls)+ let w3 = ws !!! (wsi + 3)+ let w3Dqs = testWord8s (w3 .^. rdqs)+ let w3Nls = testWord8s (w3 .^. rnls)+ let w3Dls = testWord8s (w3 .^. rdls)+ let w4 = ws !!! (wsi + 4)+ let w4Dqs = testWord8s (w4 .^. rdqs)+ let w4Nls = testWord8s (w4 .^. rnls)+ let w4Dls = testWord8s (w4 .^. rdls)+ let w5 = ws !!! (wsi + 5)+ let w5Dqs = testWord8s (w5 .^. rdqs)+ let w5Nls = testWord8s (w5 .^. rnls)+ let w5Dls = testWord8s (w5 .^. rdls)+ let w6 = ws !!! (wsi + 6)+ let w6Dqs = testWord8s (w6 .^. rdqs)+ let w6Nls = testWord8s (w6 .^. rnls)+ let w6Dls = testWord8s (w6 .^. rdls)+ let w7 = ws !!! (wsi + 7)+ let w7Dqs = testWord8s (w7 .^. rdqs)+ let w7Nls = testWord8s (w7 .^. rnls)+ let w7Dls = testWord8s (w7 .^. rdls)+ let wDqs = (w7Dqs .<. 56) .|. (w6Dqs .<. 48) .|. (w5Dqs .<. 40) .|. (w4Dqs .<. 32) .|. (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs+ let wNls = (w7Nls .<. 56) .|. (w6Nls .<. 48) .|. (w5Nls .<. 40) .|. (w4Nls .<. 32) .|. (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls+ let wDls = (w7Dls .<. 56) .|. (w6Dls .<. 48) .|. (w5Dls .<. 40) .|. (w4Dls .<. 32) .|. (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls+ let numWordQuotes = comp wDqs+ let wMask = toggle64 numQuotes numWordQuotes+ let newNumQuotes = numQuotes + fromIntegral (popCount numWordQuotes)+ DVSM.unsafeWrite markers (fromIntegral ui) (comp (wNls .&. wDls) .&. wMask)+ DVSM.unsafeWrite newlines (fromIntegral ui) (comp wNls .&. wMask)+ go markers newlines (wsi + 8) newNumQuotes++ else do+ let w0 = atIndexOr 0 ws wsi+ let w0Dqs = testWord8s (w0 .^. rdqs)+ let w0Nls = testWord8s (w0 .^. rnls)+ let w0Dls = testWord8s (w0 .^. rdls)+ let w1 = atIndexOr 0 ws (wsi + 1)+ let w1Dqs = testWord8s (w1 .^. rdqs)+ let w1Nls = testWord8s (w1 .^. rnls)+ let w1Dls = testWord8s (w1 .^. rdls)+ let w2 = atIndexOr 0 ws (wsi + 2)+ let w2Dqs = testWord8s (w2 .^. rdqs)+ let w2Nls = testWord8s (w2 .^. rnls)+ let w2Dls = testWord8s (w2 .^. rdls)+ let w3 = atIndexOr 0 ws (wsi + 3)+ let w3Dqs = testWord8s (w3 .^. rdqs)+ let w3Nls = testWord8s (w3 .^. rnls)+ let w3Dls = testWord8s (w3 .^. rdls)+ let w4 = atIndexOr 0 ws (wsi + 4)+ let w4Dqs = testWord8s (w4 .^. rdqs)+ let w4Nls = testWord8s (w4 .^. rnls)+ let w4Dls = testWord8s (w4 .^. rdls)+ let w5 = atIndexOr 0 ws (wsi + 5)+ let w5Dqs = testWord8s (w5 .^. rdqs)+ let w5Nls = testWord8s (w5 .^. rnls)+ let w5Dls = testWord8s (w5 .^. rdls)+ let w6 = atIndexOr 0 ws (wsi + 6)+ let w6Dqs = testWord8s (w6 .^. rdqs)+ let w6Nls = testWord8s (w6 .^. rnls)+ let w6Dls = testWord8s (w6 .^. rdls)+ let w7 = atIndexOr 0 ws (wsi + 7)+ let w7Dqs = testWord8s (w7 .^. rdqs)+ let w7Nls = testWord8s (w7 .^. rnls)+ let w7Dls = testWord8s (w7 .^. rdls)+ let wDqs = (w7Dqs .<. 56) .|. (w6Dqs .<. 48) .|. (w5Dqs .<. 40) .|. (w4Dqs .<. 32) .|. (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs+ let wNls = (w7Nls .<. 56) .|. (w6Nls .<. 48) .|. (w5Nls .<. 40) .|. (w4Nls .<. 32) .|. (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls+ let wDls = (w7Dls .<. 56) .|. (w6Dls .<. 48) .|. (w5Dls .<. 40) .|. (w4Dls .<. 32) .|. (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls+ let numWordQuotes = comp wDqs+ let wMask = toggle64 numQuotes numWordQuotes+ DVSM.unsafeWrite markers (fromIntegral ui) (comp (wNls .&. wDls) .&. wMask)+ DVSM.unsafeWrite newlines (fromIntegral ui) (comp wNls .&. wMask)++nextCursor :: (Rank1 s, Select1 s) => DsvCursor t s -> DsvCursor t s+nextCursor cursor = cursor+ { dsvCursorPosition = newPos+ }+ where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1)
+ src/HaskellWorks/Data/Dsv/Strict/Cursor/Internal/Reference.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference where++import Data.Bits (popCount)+import Data.Semigroup+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Dsv.Internal.Bits+import HaskellWorks.Data.Dsv.Internal.Broadword+import HaskellWorks.Data.Dsv.Internal.Char.Word64+import HaskellWorks.Data.Dsv.Strict.Cursor.Type+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Internal.Char.Word64 as CW++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++unsafeIndex :: DVS.Vector Word64 -> Int -> Word64+unsafeIndex v i | i < 0 = error $ "Invalid index: " <> show i <> " for vector sized " <> show (DVS.length v)+unsafeIndex v i | fromIntegral i >= DVS.length v = error $ "Invalid index: " <> show i <> " for vector sized " <> show (DVS.length v)+unsafeIndex v i | otherwise = DVS.unsafeIndex v (fromIntegral i)+-- unsafeIndex v i = DVS.unsafeIndex v (fromIntegral i)+{-# INLINE unsafeIndex #-}++dvsLength :: DVS.Vector Word64 -> Int+dvsLength v = fromIntegral (DVS.length v)+{-# INLINE dvsLength #-}++atIndexOr2 :: Word64 -> DVS.Vector Word64 -> Int -> Word64+atIndexOr2 d _ i | i < 0 = d+atIndexOr2 d v i | fromIntegral i >= DVS.length v = d+atIndexOr2 _ v i | otherwise = unsafeIndex v (fromIntegral i)+{-# NOINLINE atIndexOr2 #-}++-- rdqs: repeated double quotes+-- rnls: repeated new lines+-- rdls: repeated delimiters+-- numQuotes: Number of quotes since beginning+-- n: Number of rank select bit string words since beginning+-- returns: dquote interest bits in high part and other interest bits in low part+mkDsvRawBitsByWord64s :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+mkDsvRawBitsByWord64s rdqs rnls rdls v = DVS.constructN (((DVS.length v + 7) `div` 8) * 2) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let vi = dvsLength u * 4 in+ if dvsLength v - vi >= 4+ then let w0 = unsafeIndex v vi+ w0Dqs = testWord8s (w0 .^. rdqs)+ w0Nls = testWord8s (w0 .^. rnls)+ w0Dls = testWord8s (w0 .^. rdls)+ w1 = unsafeIndex v (vi + 1)+ w1Dqs = testWord8s (w1 .^. rdqs)+ w1Nls = testWord8s (w1 .^. rnls)+ w1Dls = testWord8s (w1 .^. rdls)+ w2 = unsafeIndex v (vi + 2)+ w2Dqs = testWord8s (w2 .^. rdqs)+ w2Nls = testWord8s (w2 .^. rnls)+ w2Dls = testWord8s (w2 .^. rdls)+ w3 = unsafeIndex v (vi + 3)+ w3Dqs = testWord8s (w3 .^. rdqs)+ w3Nls = testWord8s (w3 .^. rnls)+ w3Dls = testWord8s (w3 .^. rdls)+ wDqs = (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs+ wNls = (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls+ wDls = (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls+ in (comp (wDqs .<. 32) .&. 0xffffffff00000000) .|. (comp (wNls .&. wDls) .&. 0x00000000ffffffff)+ else let w0 = atIndexOr2 0 v vi+ w0Dqs = testWord8s (w0 .^. rdqs)+ w0Nls = testWord8s (w0 .^. rnls)+ w0Dls = testWord8s (w0 .^. rdls)+ w1 = atIndexOr2 0 v (vi + 1)+ w1Dqs = testWord8s (w1 .^. rdqs)+ w1Nls = testWord8s (w1 .^. rnls)+ w1Dls = testWord8s (w1 .^. rdls)+ w2 = atIndexOr2 0 v (vi + 2)+ w2Dqs = testWord8s (w2 .^. rdqs)+ w2Nls = testWord8s (w2 .^. rnls)+ w2Dls = testWord8s (w2 .^. rdls)+ w3 = atIndexOr2 0 v (vi + 3)+ w3Dqs = testWord8s (w3 .^. rdqs)+ w3Nls = testWord8s (w3 .^. rnls)+ w3Dls = testWord8s (w3 .^. rdls)+ wDqs = (w3Dqs .<. 24) .|. (w2Dqs .<. 16) .|. (w1Dqs .<. 8) .|. w0Dqs+ wNls = (w3Nls .<. 24) .|. (w2Nls .<. 16) .|. (w1Nls .<. 8) .|. w0Nls+ wDls = (w3Dls .<. 24) .|. (w2Dls .<. 16) .|. (w1Dls .<. 8) .|. w0Dls+ in (comp (wDqs .<. 32) .&. 0xffffffff00000000) .|. (comp (wNls .&. wDls) .&. 0x00000000ffffffff)++mkCummulativeDqPopCount :: DVS.Vector Word64 -> DVS.Vector Word64+mkCummulativeDqPopCount v = DVS.constructN (DVS.length v `div` 2) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = dvsLength u+ vi = ui * 2+ in if dvsLength v - vi >= 2 && vi > 0+ then let w0 = unsafeIndex v vi+ w1 = unsafeIndex v (vi + 1)+ w = (w1 .&. 0xffffffff00000000) .|. (w0 .>. 32)+ in unsafeIndex u (ui - 1) + fromIntegral (popCount w)+ else let w0 = atIndexOr2 0 v vi+ w1 = atIndexOr2 0 v (vi + 1)+ w = (w1 .&. 0xffffffff00000000) .|. (w0 .>. 32)+ in atIndexOr2 0 u (ui - 1) + fromIntegral (popCount w)++mkIbVector' :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+mkIbVector' rawBits cpcs v = DVS.constructN ((DVS.length v + 7) `div` 8) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = dvsLength u in if ui > 1+ then let vi = ui * 2+ cpc = unsafeIndex cpcs (ui - 1)+ w0 = unsafeIndex rawBits vi+ w1 = unsafeIndex rawBits (vi + 1)+ w = ((w1 .&. 0x00000000ffffffff) .<. 32) .|. ( w0 .&. 0x00000000ffffffff )+ d = ( w1 .&. 0xffffffff00000000 ) .|. ((w0 .&. 0xffffffff00000000) .>. 32)+ m = toggle64 cpc d+ in w .&. m+ else let vi = fromIntegral (ui * 2)+ cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1))+ w0 = atIndexOr 0 rawBits vi+ w1 = atIndexOr 0 rawBits (vi + 1)+ w = ((w1 .&. 0x00000000ffffffff) .<. 32) .|. ( w0 .&. 0x00000000ffffffff )+ d = ( w1 .&. 0xffffffff00000000 ) .|. ((w0 .&. 0xffffffff00000000) .>. 32)+ m = toggle64 cpc d+ in w .&. m++mkIbVector :: Char -> DVS.Vector Word64 -> DVS.Vector Word64+mkIbVector delimiter v = mkIbVector' rawBits cpcs v+ where rdqs = CW.doubleQuote+ rnls = CW.newline+ rdls = fillWord64WithChar8 delimiter+ rawBits = mkDsvRawBitsByWord64s rdqs rnls rdls v+ cpcs = mkCummulativeDqPopCount rawBits -- cummulative popcounts++-- rdqs: repeated double quotes+-- rnls: repeated new lines+-- rdls: repeated delimiters+-- numQuotes: Number of quotes since beginning+-- n: Number of rank select bit string words since beginning+-- returns: dquote interest bits in high part and other interest bits in low part+mkStripes :: Word64 -> Word64 -> Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+mkStripes rdqs rnls rdls v = DVS.constructN (((DVS.length v + 7) `div` 8) * 3) go+ where stripePatterns = DVS.fromList [rdqs, rnls, rdls]+ go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = dvsLength u+ si = ui `mod` 3+ vi = (ui `div` 3) * 8+ ws = unsafeIndex stripePatterns si+ in if dvsLength v - vi >= 4+ then let w0 = testWord8s (unsafeIndex v (vi + 0) .^. ws)+ w1 = testWord8s (unsafeIndex v (vi + 1) .^. ws)+ w2 = testWord8s (unsafeIndex v (vi + 2) .^. ws)+ w3 = testWord8s (unsafeIndex v (vi + 3) .^. ws)+ w4 = testWord8s (unsafeIndex v (vi + 4) .^. ws)+ w5 = testWord8s (unsafeIndex v (vi + 5) .^. ws)+ w6 = testWord8s (unsafeIndex v (vi + 6) .^. ws)+ w7 = testWord8s (unsafeIndex v (vi + 7) .^. ws)+ wa = (w7 .<. 56) .|. (w6 .<. 48) .|. (w5 .<. 40) .|. (w4 .<. 32) .|.+ (w3 .<. 24) .|. (w2 .<. 16) .|. (w1 .<. 8) .|. w0+ in comp wa+ else let w0 = testWord8s (atIndexOr2 0 v (vi + 0) .^. ws)+ w1 = testWord8s (atIndexOr2 0 v (vi + 1) .^. ws)+ w2 = testWord8s (atIndexOr2 0 v (vi + 2) .^. ws)+ w3 = testWord8s (atIndexOr2 0 v (vi + 3) .^. ws)+ w4 = testWord8s (atIndexOr2 0 v (vi + 4) .^. ws)+ w5 = testWord8s (atIndexOr2 0 v (vi + 5) .^. ws)+ w6 = testWord8s (atIndexOr2 0 v (vi + 6) .^. ws)+ w7 = testWord8s (atIndexOr2 0 v (vi + 7) .^. ws)+ wa = (w7 .<. 56) .|. (w6 .<. 48) .|. (w5 .<. 40) .|. (w4 .<. 32) .|.+ (w3 .<. 24) .|. (w2 .<. 16) .|. (w1 .<. 8) .|. w0+ in comp wa++mkCummulativeDqPopCountFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64+mkCummulativeDqPopCountFromStriped v = DVS.constructN (DVS.length v `div` 3) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = dvsLength u+ vi = ui * 3+ w = unsafeIndex v vi+ in unsafeIndex u (ui - 1) + fromIntegral (popCount w)++mkDsvIbNlFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+mkDsvIbNlFromStriped sv cpcs = DVS.constructN ((DVS.length sv) `div` 3) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = dvsLength u in if ui > 1+ then let svi = ui * 2+ cpc = unsafeIndex cpcs (ui - 1)+ wdq = unsafeIndex sv svi+ wnl = unsafeIndex sv (svi + 1)+ m = toggle64 cpc wdq+ in wnl .&. m+ else let svi = fromIntegral (ui * 2)+ cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1))+ wdq = atIndexOr 0 sv svi+ wnl = atIndexOr 0 sv (svi + 1)+ m = toggle64 cpc wdq+ in wnl .&. m++mkDsvIbDlFromStriped :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+mkDsvIbDlFromStriped sv cpcs = DVS.constructN ((DVS.length sv) `div` 3) go+ where go :: DVS.Vector Word64 -> Word64+ go u = let ui = dvsLength u in if ui > 1+ then let svi = ui * 2+ cpc = unsafeIndex cpcs (ui - 1)+ wdq = unsafeIndex sv svi+ wdl = unsafeIndex sv (svi + 2)+ m = toggle64 cpc wdq+ in wdl .&. m+ else let svi = fromIntegral (ui * 2)+ cpc = atIndexOrBeforeOrLast 0 cpcs (fromIntegral (ui - 1))+ wdq = atIndexOr 0 sv svi+ wdl = atIndexOr 0 sv (svi + 2)+ m = toggle64 cpc wdq+ in wdl .&. m++nextCursor :: (Rank1 s, Select1 s) => DsvCursor t s -> DsvCursor t s+nextCursor cursor = cursor+ { dsvCursorPosition = newPos+ }+ where currentRank = rank1 (dsvCursorMarkers cursor) (dsvCursorPosition cursor)+ newPos = select1 (dsvCursorMarkers cursor) (currentRank + 1)
+ src/HaskellWorks/Data/Dsv/Strict/Cursor/Type.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.Dsv.Strict.Cursor.Type+ ( DsvCursor(..)+ ) where++import Data.Word+import HaskellWorks.Data.Container++data DsvCursor t s = DsvCursor+ { dsvCursorDelimiter :: Elem t+ , dsvCursorText :: !t+ , dsvCursorMarkers :: !s+ , dsvCursorNewlines :: !s+ , dsvCursorPosition :: !Word64+ }++deriving instance (Eq (Elem t), Eq t, Eq s) => Eq (DsvCursor t s)+deriving instance (Show (Elem t), Show t, Show s) => Show (DsvCursor t s)
+ test/HaskellWorks/Data/Dsv/BroadwordSpec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dsv.BroadwordSpec (spec) where++import Control.Concurrent+import Control.Monad.IO.Class+import Data.Maybe (fromJust)+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Dsv.Internal.Broadword+import HaskellWorks.Data.FromByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference as SVS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: redundant bracket" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Dsv.BroadwordSpec" $ do+ it "Case 0" $ requireProperty $ do+ let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64+ let expected = fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64+ bitShow actual === bitShow expected+ it "Case 1" $ requireProperty $ do+ let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64+ let expected = fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64+ bitShow actual === bitShow expected+ it "Case 1" $ requireProperty $ do+ let actual = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64+ let expected = fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64+ bitShow actual === bitShow expected++{-+ normal case+ -----------+ 00100100+ 11011011++ 00010000+ 11011011 +++ 11000111+ carry case+ -----------+ 00100100+ 11011011+ | |+ 10000010+ 11011011 ++ 00111000+-}
+ test/HaskellWorks/Data/Dsv/Gen.hs view
@@ -0,0 +1,10 @@+module HaskellWorks.Data.Dsv.Gen where++import Hedgehog++import qualified Data.ByteString as BS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++bytestring :: MonadGen m => R.Range Int -> m BS.ByteString+bytestring r = BS.pack <$> G.list r (G.word8 R.constantBounded)
+ test/HaskellWorks/Data/Dsv/Strict/Cursor/InternalSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dsv.Strict.Cursor.InternalSpec (spec) where++import Control.Concurrent+import Control.Monad+import Control.Monad.IO.Class+import Data.ByteString (ByteString)+import Data.Char+import Data.List (isSuffixOf)+import Data.Maybe (fromJust)+import Data.Text (Text)+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Dsv.Internal.Broadword+import HaskellWorks.Data.FromByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Gen as G+import qualified HaskellWorks.Data.Dsv.Internal.Char.Word64 as C+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 Hedgehog.Gen as G+import qualified Hedgehog.Range as R+import qualified System.Directory as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Dsv.Strict.Cursor.InternalSpec" $ do+ it "Case 1" $ requireTest $ do+ entries <- liftIO $ IO.listDirectory "data/bench"+ let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+ forM_ files $ \file -> do+ v <- liftIO $ IO.mmapFromForeignRegion file+ let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes '|' v)+ let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector '|' v)+ actual === expected+ it "Case 2" $ requireTest $ do+ bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 128) (G.element " \"|\n")+ v <- forAll $ pure $ fromByteString bs+ let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes '|' v)+ let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector '|' v)+ actual === expected+ it "Case 3" $ requireTest $ do+ bs :: ByteString <- forAll $ T.encodeUtf8 . T.pack <$> G.string (R.linear 0 128) (G.element " \"|\n")+ v <- forAll $ pure $ fromByteString bs+ let !actual = DVS.foldr (\a b -> popCount1 a + b) 0 (fst $ SVS.makeIndexes '|' v)+ let !expected = DVS.foldr (\a b -> popCount1 a + b) 0 ( SVS.mkIbVector '|' v)+ actual === expected+ it "Case 4" $ 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 '|' v+ let !pc = DVS.foldr (\a b -> popCount1 a + b) 0 u+ pc === fromIntegral numQuotes+ 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 '|' v+ let !expected = SVS.mkIbVector '|' 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"+ let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+ forM_ files $ \file -> do+ v <- liftIO $ IO.mmapFromForeignRegion file+ let !actual = fst $ SVS.makeIndexes '|' v+ let !expected = SVS.mkIbVector '|' v+ annotate $ "file : " <> file+ actual === expected
+ test/HaskellWorks/Data/DsvSpec.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.DsvSpec (spec) where++import Control.Concurrent+import Control.Monad.IO.Class+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.FromByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS+import qualified HaskellWorks.Data.Dsv.Strict.Cursor.Internal.Reference as SVS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: redundant bracket" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.DsvSpec" $ do+ it "Parsing Basic DSV" $ requireTest $ do+ let bs = "12345678,12345678,123456,abcdefghijklmnopqrstuvwxyz\n\+ \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 ',' v++ bitShow actual === "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"+ it "Parsing Quoted DSV" $ requireTest $ do+ let bs = "12345678,12345678,123456,\"bcdefghijklmnopqrstuvwxy\"\n\+ \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 ',' v++ bitShow actual === "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"+ it "Parsing Quoted DSV" $ requireTest $ do+ let bs = "12345678,12345678,123456,\"bcdefghijklm,opqrstuvwxy\"\n\+ \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 ',' v++ bitShow actual === "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"+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ weigh/Space.hs view
@@ -0,0 +1,40 @@+module Main where++import Data.ByteString (ByteString)+import Data.Vector (Vector)+import Weigh++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Csv as CSV+import qualified Data.Vector as DV+import qualified HaskellWorks.Data.Dsv.Strict.Cursor as SVS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++repeatedly :: (a -> Maybe a) -> a -> [a]+repeatedly f a = a:case f a of+ Just b -> repeatedly f b+ Nothing -> []++loadCsv :: FilePath -> IO (DV.Vector (DV.Vector ByteString))+loadCsv filePath = do+ c <- SVS.mmapCursor ',' False filePath++ return $ SVS.toVectorVector c++main :: IO ()+main = do+ let infp = "data/bench/data-0001000.csv"+ mainWith $ do+ setColumns [Case, Allocated, Max, Live, GCs]+ sequence_+ [ action "cassava/decode/Vector ByteString" $ do+ r <- fmap (CSV.decode CSV.HasHeader) (LBS.readFile infp) :: IO (Either String (Vector (Vector ByteString)))+ case r of+ Left _ -> error "Unexpected parse error"+ Right v -> pure v+ , action "hw-dsv/decode/Vector ByteString" $ do+ v <- loadCsv infp :: IO (Vector (Vector ByteString))+ pure v+ ]+ return ()