hw-simd-cli (empty) → 0.0.0.1
raw patch · 19 files changed
+967/−0 lines, 19 filesdep +basedep +bits-extradep +bytestringsetup-changed
Dependencies added: base, bits-extra, bytestring, containers, deepseq, directory, doctest, doctest-discover, generic-lens, hw-bits, hw-prim, hw-rankselect-base, hw-simd, hw-simd-cli, lens, mmap, mtl, optparse-applicative, resourcet, vector
Files
- ChangeLog.md +1/−0
- LICENSE +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- app/App/Char.hs +25/−0
- app/App/Commands.hs +20/−0
- app/App/Commands/Cat.hs +78/−0
- app/App/Commands/Chunks.hs +73/−0
- app/App/Commands/CmpEq8s.hs +95/−0
- app/App/Commands/Cut.hs +213/−0
- app/App/Commands/Options/Type.hs +42/−0
- app/App/Commands/Wc.hs +69/−0
- app/App/IO.hs +45/−0
- app/Main.hs +10/−0
- doctest/DoctestDriver.hs +12/−0
- hw-simd-cli.cabal +140/−0
- src/HaskellWorks/Simd/Cli/ChunkData.hs +32/−0
- src/HaskellWorks/Simd/Cli/Comparison.hs +58/−0
- src/HaskellWorks/Simd/Cli/CutCursor.hs +19/−0
+ ChangeLog.md view
@@ -0,0 +1,1 @@+# Changelog for hw-simd-cli
+ 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,3 @@+# hw-simd-cli+[](https://circleci.com/gh/haskell-works/hw-simd-cli)+[](https://travis-ci.org/haskell-works/hw-simd-cli)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App/Char.hs view
@@ -0,0 +1,25 @@+module App.Char where++import Data.Char+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++readWord8 :: ReadM Word8+readWord8 = fromIntegral . ord <$> readChar
+ app/App/Commands.hs view
@@ -0,0 +1,20 @@+module App.Commands where++import App.Commands.Cat+import App.Commands.Chunks+import App.Commands.CmpEq8s+import App.Commands.Cut+import App.Commands.Wc+import Options.Applicative++commands :: Parser (IO ())+commands = commandsGeneral++commandsGeneral :: Parser (IO ())+commandsGeneral = subparser $ mempty+ <> commandGroup "Commands:"+ <> cmdCat+ <> cmdChunks+ <> cmdCmpEq8s+ <> cmdCut+ <> cmdWc
+ app/App/Commands/Cat.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Cat+ ( cmdCat+ ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Maybe (fromMaybe)+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Internal as BSI+import qualified HaskellWorks.Data.ByteString.Lazy as LBS+import qualified System.Exit as IO+import qualified System.IO as IO++runCat :: Z.CatOptions -> IO ()+runCat opts = case opts ^. the @"method" of+ "default" -> do+ bs <- LBS.hGetContents =<< IO.openInputFile (opts ^. the @"inputFile")+ IO.writeOutputFile (opts ^. the @"outputFile") bs+ "rechunk" -> case opts ^. the @"chunkSize" of+ Just chunkSize -> do+ bs <- LBS.hGetContents =<< IO.openInputFile (opts ^. the @"inputFile")+ IO.writeOutputFile (opts ^. the @"outputFile") (LBS.rechunk chunkSize bs)+ Nothing -> do+ IO.hPutStrLn IO.stderr "Missing option --chunk-size"+ IO.exitWith $ IO.ExitFailure 1+ "resegment" -> case opts ^. the @"chunkSize" of+ Just chunkSize -> do+ bs <- LBS.hGetContents =<< IO.openInputFile (opts ^. the @"inputFile")+ IO.writeOutputFile (opts ^. the @"outputFile") (LBS.resegment chunkSize bs)+ Nothing -> do+ IO.hPutStrLn IO.stderr "Missing option --chunk-size"+ IO.exitWith $ IO.ExitFailure 1+ "prechunk" -> do+ let defaultChunkSize = (BSI.defaultChunkSize `div` 64) * 64+ let chunkSize = fromMaybe defaultChunkSize (opts ^. the @"chunkSize")+ bs <- LBS.hGetContentsChunkedBy chunkSize =<< IO.openInputFile (opts ^. the @"inputFile")+ IO.writeOutputFile (opts ^. the @"outputFile") (LBS.toLazyByteString bs)+ method -> do+ IO.putStrLn $ "Invalid method: " <> method+ IO.exitWith $ IO.ExitFailure 1++optsCat :: Parser Z.CatOptions+optsCat = Z.CatOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "method"+ <> short 'm'+ <> help "Method"+ <> metavar "STRING"+ )+ <*> optional (option auto+ ( long "chunk-size"+ <> short 'c'+ <> help "Chunk size. Recommended chunk-size is 32256"+ <> metavar "BYTES"+ )+ )++cmdCat :: Mod CommandFields (IO ())+cmdCat = command "cat" $ flip info idm $ runCat <$> optsCat
+ app/App/Commands/Chunks.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Chunks+ ( cmdChunks+ ) where++import Control.Lens+import Control.Monad+import Control.Monad.Except+import Data.Generics.Product.Any+import HaskellWorks.Data.ByteString+import HaskellWorks.Data.Vector.AsVector8ns+import HaskellWorks.Data.Vector.AsVector8s+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map as M+import qualified HaskellWorks.Simd.Cli.ChunkData as Z+import qualified System.Exit as IO+import qualified System.IO as IO++{- HLINT ignore "Redundant do" -}++runChunks :: Z.ChunksOptions -> IO ()+runChunks opts = void $ runExceptT $ flip catchError handler $ do+ lbs <- liftIO $ case opts ^. the @"readMethod" of+ "classic" -> IO.readInputFileClassic (opts ^. the @"inputFile")+ "aligned" -> IO.readInputFile (opts ^. the @"inputFile")+ _ -> error "Invalid read method"++ chunkData <- case opts ^. the @"chunkMethod" of+ "chunked" -> return $ foldMap Z.chunkDataOf (LBS.toChunks lbs)+ "regular" -> return $ foldMap Z.chunkDataOf (toByteString <$> asVector8s 512 lbs)+ "flexible" -> return $ foldMap Z.chunkDataOf (toByteString <$> asVector8ns 512 lbs)+ unknown -> throwError $ "Unknown method: " <> show unknown++ liftIO $ IO.putStrLn $ "Total chunks: " <> show (chunkData ^. the @"count")+ liftIO $ IO.putStrLn "Chunk histogram: "++ forM_ (chunkData ^. the @"sizes" & M.toList) $ \(size, count) -> do+ liftIO $ IO.putStrLn $ show size <> "," <> show count+ where handler :: String -> ExceptT String IO ()+ handler e = do+ liftIO $ IO.putStrLn $ "Error: " <> e+ void $ liftIO IO.exitFailure+++optsChunks :: Parser Z.ChunksOptions+optsChunks = Z.ChunksOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "chunk-method"+ <> short 'm'+ <> help "Chunk method"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "read-method"+ <> short 'r'+ <> help "Read method"+ <> metavar "STRING"+ )++cmdChunks :: Mod CommandFields (IO ())+cmdChunks = command "chunks" $ flip info idm $ runChunks <$> optsChunks
+ app/App/Commands/CmpEq8s.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.CmpEq8s+ ( cmdCmpEq8s+ ) where++import App.Char+import Control.Lens+import Data.Generics.Product.Any+import HaskellWorks.Data.Vector.AsVector64s+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified HaskellWorks.Data.ByteString.Lazy as LBS+import qualified HaskellWorks.Data.Simd.ChunkString as CS+import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2+import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK+import qualified HaskellWorks.Simd.Cli.Comparison as SERIAL+import qualified System.Exit as IO+import qualified System.IO as IO++{- HLINT ignore "Redundant do" -}++runCmpEq8s :: Z.CmpEq8sOptions -> IO ()+runCmpEq8s opts = do+ let !delimiter = opts ^. the @"delimiter"++ case opts ^. the @"cmpMethod" of+ "new-stock" -> do+ cs <- IO.openInputFile (opts ^. the @"inputFile") >>= CS.hGetContents++ IO.writeOutputFile (opts ^. the @"outputFile")+ $ LBS.toLazyByteString+ $ STOCK.cmpEqWord8s delimiter cs+ "new-avx2" -> do+ cs <- IO.openInputFile (opts ^. the @"inputFile") >>= CS.hGetContents++ IO.writeOutputFile (opts ^. the @"outputFile")+ $ LBS.toLazyByteString+ $ AVX2.cmpEqWord8s delimiter cs+ "stock" -> do+ bs <- IO.readInputFile (opts ^. the @"inputFile")+ let v = asVector64s 64 bs++ IO.writeOutputFile (opts ^. the @"outputFile")+ $ LBS.toLazyByteString+ $ STOCK.cmpEqWord8s delimiter v+ "avx2" -> do+ bs <- IO.readInputFile (opts ^. the @"inputFile")+ let v = asVector64s 64 bs++ IO.writeOutputFile (opts ^. the @"outputFile")+ $ LBS.toLazyByteString+ $ AVX2.cmpEqWord8s delimiter v+ "serial" -> do+ bs <- IO.readInputFile (opts ^. the @"inputFile")++ IO.writeOutputFile (opts ^. the @"outputFile")+ $ SERIAL.cmpEqWord8s delimiter bs+ m -> do+ IO.hPutStrLn IO.stderr $ "Unsupported method: " <> m+ IO.exitFailure++optsCmpEq8s :: Parser Z.CmpEq8sOptions+optsCmpEq8s = Z.CmpEq8sOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input Text file"+ <> metavar "STRING"+ )+ <*> option readWord8+ ( long "input-delimiter"+ <> short 'd'+ <> help "Text delimiter"+ <> metavar "CHAR"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "cmp-method"+ <> short 'm'+ <> help "Comparison method"+ <> metavar "STRING"+ )++cmdCmpEq8s :: Mod CommandFields (IO ())+cmdCmpEq8s = command "cmpeqword8s" $ flip info idm $ runCmpEq8s <$> optsCmpEq8s
+ app/App/Commands/Cut.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Cut+ ( cmdCut+ ) where++import App.Char+import Control.Lens+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.Char (ord)+import Data.Generics.Product.Any+import Data.List (intersperse)+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.Vector.AsVector64s+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector as DV+import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2+import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK+import qualified HaskellWorks.Simd.Cli.Comparison as SERIAL+import qualified HaskellWorks.Simd.Cli.CutCursor as Z+import qualified System.Exit as IO+import qualified System.IO as IO++{- HLINT ignore "Redundant do" -}++runCut :: Z.CutOptions -> IO ()+runCut opts = do+ let !delimiter = opts ^. the @"delimiter"++ bs <- IO.readInputFile (opts ^. the @"inputFile")+ let wNewline = fromIntegral $ ord '\n'+ let !outDelimiterBuilder = B.word8 (opts ^. the @"outDelimiter")++ cursorResult <- case opts ^. the @"method" of+ "stock" -> do+ let v = asVector64s 64 bs+ return $ Right Z.CutCursor+ { Z.text = bs+ , Z.markers = STOCK.cmpEqWord8s delimiter v+ , Z.newlines = STOCK.cmpEqWord8s wNewline v+ , Z.position = 1+ }+ "avx2" -> do+ let v = asVector64s 64 bs+ return $ Right Z.CutCursor+ { Z.text = bs+ , Z.markers = AVX2.cmpEqWord8s delimiter v+ , Z.newlines = AVX2.cmpEqWord8s wNewline v+ , Z.position = 1+ }+ "serial" -> do+ IO.writeOutputFile (opts ^. the @"outputFile")+ $ SERIAL.cmpEqWord8s delimiter bs+ return $ Right Z.CutCursor+ { Z.text = bs+ , Z.markers = asVector64s 64 $ SERIAL.cmpEqWord8s delimiter bs+ , Z.newlines = asVector64s 64 $ SERIAL.cmpEqWord8s wNewline bs+ , Z.position = 1+ }+ m -> do+ return $ Left $ "Unsupported method: " <> m++ case cursorResult of+ Right cursor -> do+ let rows = toListVector cursor++ runResourceT $ do+ (_, hOut) <- IO.openOutputFile (opts ^. the @"outputFile") Nothing+ forM_ rows $ \row -> do+ let fieldStrings = columnToFieldString row <$> (opts ^. the @"fields")++ liftIO $ B.hPutBuilder hOut $ mconcat (intersperse outDelimiterBuilder fieldStrings) <> B.word8 10++ return ()+ return ()++ Left msg -> do+ IO.hPutStrLn IO.stderr msg+ IO.exitFailure++ 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++optsCut :: Parser Z.CutOptions+optsCut = Z.CutOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input Text file"+ <> metavar "STRING"+ )+ <*> option readWord8+ ( long "input-delimiter"+ <> short 'd'+ <> help "Text delimiter"+ <> metavar "CHAR"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output Text file"+ <> metavar "STRING"+ )+ <*> option readWord8+ ( long "output-delimiter"+ <> short 'e'+ <> help "Text delimiter"+ <> metavar "CHAR"+ )+ <*> many+ ( option auto+ ( long "fields"+ <> short 'f'+ <> help "Fields"+ <> metavar "INT"+ )+ )+ <*> strOption+ ( long "method"+ <> short 'm'+ <> help "Comparison method"+ <> metavar "STRING"+ )++cmdCut :: Mod CommandFields (IO ())+cmdCut = command "cut" $ flip info idm $ runCut <$> optsCut++atEnd :: Z.CutCursor -> Bool+atEnd c = LBS.null (LBS.drop (fromIntegral (Z.position c)) (Z.text c))+{-# INLINE atEnd #-}++toListVector :: Z.CutCursor -> [DV.Vector LBS.ByteString]+toListVector c = if Z.position d > Z.position c && not (atEnd c)+ then getRowBetween c d dEnd:toListVector (trim d)+ else []+ where nr = nextRow c+ d = nextPosition nr+ dEnd = atEnd nr+{-# INLINE toListVector #-}++getRowBetween :: Z.CutCursor -> Z.CutCursor -> Bool -> DV.Vector LBS.ByteString+getRowBetween c d dEnd = DV.unfoldrN fields go c+ where cr = rank1 (Z.markers c) (Z.position c)+ dr = rank1 (Z.markers d) (Z.position d)+ c2d = fromIntegral (dr - cr)+ fields = if dEnd then c2d +1 else c2d+ go :: Z.CutCursor -> Maybe (LBS.ByteString, Z.CutCursor)+ go e = case nextField e of+ f -> case nextPosition f of+ g -> case snippet e of+ s -> Just (s, g)+ {-# INLINE go #-}+{-# INLINE getRowBetween #-}++snippet :: Z.CutCursor -> LBS.ByteString+snippet c = LBS.take (len `max` 0) $ LBS.drop posC $ Z.text c+ where d = nextField c+ posC = fromIntegral $ Z.position c+ posD = fromIntegral $ Z.position d+ len = posD - posC+{-# INLINE snippet #-}++nextField :: Z.CutCursor -> Z.CutCursor+nextField cursor = cursor+ { Z.position = newPos+ }+ where currentRank = rank1 (Z.markers cursor) (Z.position cursor)+ newPos = select1 (Z.markers cursor) (currentRank + 1) - 1+{-# INLINE nextField #-}++trim :: Z.CutCursor -> Z.CutCursor+trim c = if Z.position c >= 512+ then trim c+ { Z.text = LBS.drop 512 (Z.text c)+ , Z.markers = drop 1 (Z.markers c)+ , Z.newlines = drop 1 (Z.newlines c)+ , Z.position = Z.position c - 512+ }+ else c+{-# INLINE trim #-}++nextPosition :: Z.CutCursor -> Z.CutCursor+nextPosition cursor = cursor+ { Z.position = if LBS.null (LBS.drop (fromIntegral newPos) (Z.text cursor))+ then fromIntegral (LBS.length (Z.text cursor))+ else newPos+ }+ where newPos = Z.position cursor + 1+{-# INLINE nextPosition #-}++nextRow :: Z.CutCursor -> Z.CutCursor+nextRow cursor = cursor+ { Z.position = if newPos > Z.position cursor+ then newPos+ else fromIntegral (LBS.length (Z.text cursor))++ }+ where currentRank = rank1 (Z.newlines cursor) (Z.position cursor)+ newPos = select1 (Z.newlines cursor) (currentRank + 1) - 1+{-# INLINE nextRow #-}
+ app/App/Commands/Options/Type.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}++module App.Commands.Options.Type where++import GHC.Generics+import GHC.Word (Word8)++data CmpEq8sOptions = CmpEq8sOptions+ { inputFile :: FilePath+ , delimiter :: Word8+ , outputFile :: FilePath+ , cmpMethod :: String+ } deriving (Eq, Show, Generic)++data CatOptions = CatOptions+ { inputFile :: FilePath+ , outputFile :: FilePath+ , method :: String+ , chunkSize :: Maybe Int+ } deriving (Eq, Show, Generic)++data ChunksOptions = ChunksOptions+ { inputFile :: FilePath+ , chunkMethod :: String+ , readMethod :: String+ } deriving (Eq, Show, Generic)++data CutOptions = CutOptions+ { inputFile :: FilePath+ , delimiter :: Word8+ , outputFile :: FilePath+ , outDelimiter :: Word8+ , fields :: [Int]+ , method :: String+ } deriving (Eq, Show, Generic)++data WcOptions = WcOptions+ { inputFile :: FilePath+ , outputFile :: FilePath+ , method :: String+ } deriving (Eq, Show, Generic)
+ app/App/Commands/Wc.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Wc+ ( cmdWc+ ) where++import Control.Lens+import Data.Char (ord)+import Data.Generics.Product.Any+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Vector.AsVector64s+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified App.IO as IO+import qualified Data.ByteString.Lazy as LBS+import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2+import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK+import qualified HaskellWorks.Simd.Cli.Comparison as SERIAL+import qualified System.Exit as IO+import qualified System.IO as IO++{- HLINT ignore "Redundant do" -}++runWc :: Z.WcOptions -> IO ()+runWc opts = do+ bs <- IO.readInputFile (opts ^. the @"inputFile")+ let wNewline = fromIntegral $ ord '\n'++ numRowsResult <- case opts ^. the @"method" of+ "stock" -> return $ Right $ popCount1 $ STOCK.cmpEqWord8s wNewline $ asVector64s 64 bs+ "avx2" -> return $ Right $ popCount1 $ AVX2.cmpEqWord8s wNewline $ asVector64s 64 bs+ "serial" -> return $ Right $ popCount1 $ asVector64s 64 $ SERIAL.cmpEqWord8s wNewline bs+ "simple" -> return $ Right $ LBS.foldl (\wc b -> if b == 10 then wc + 1 else wc) 0 bs+ m -> return $ Left $ "Unsupported method: " <> m++ case numRowsResult of+ Right numRows -> IO.print numRows++ Left msg -> do+ IO.hPutStrLn IO.stderr msg+ IO.exitFailure++ return ()++optsWc :: Parser Z.WcOptions+optsWc = Z.WcOptions+ <$> strOption+ ( long "input"+ <> short 'i'+ <> help "Input Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "output"+ <> short 'o'+ <> help "Output Text file"+ <> metavar "STRING"+ )+ <*> strOption+ ( long "method"+ <> short 'm'+ <> help "Comparison method"+ <> metavar "STRING"+ )++cmdWc :: Mod CommandFields (IO ())+cmdWc = command "wc" $ flip info idm $ runWc <$> optsWc
+ app/App/IO.hs view
@@ -0,0 +1,45 @@+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 HaskellWorks.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++openInputFile :: FilePath -> IO IO.Handle+openInputFile "-" = return IO.stdin+openInputFile filePath = IO.openBinaryFile filePath IO.ReadMode++readInputFile :: FilePath -> IO LBS.ByteString+readInputFile "-" = LBS.hGetContentsChunkedBy chunkSize IO.stdin+readInputFile filePath = IO.openBinaryFile filePath IO.ReadMode >>= LBS.hGetContentsChunkedBy chunkSize++readInputFileClassic :: FilePath -> IO LBS.ByteString+readInputFileClassic "-" = LBS.hGetContents IO.stdin+readInputFileClassic filePath = IO.openBinaryFile filePath IO.ReadMode >>= LBS.hGetContents++readInputFileChunkedBy :: Int -> FilePath -> IO LBS.ByteString+readInputFileChunkedBy size "-" = LBS.hGetContentsChunkedBy size IO.stdin+readInputFileChunkedBy size filePath = do+ h <- IO.openBinaryFile filePath IO.ReadMode+ LBS.hGetContentsChunkedBy size h++writeOutputFile :: FilePath -> LBS.ByteString -> IO ()+writeOutputFile "-" bs = LBS.hPut IO.stdout bs+writeOutputFile filePath bs = LBS.writeFile filePath bs++chunkSize :: Int+chunkSize = 4 * 1024
+ app/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import App.Commands+import Control.Monad+import Options.Applicative++main :: IO ()+main = join $ customExecParser+ (prefs $ showHelpOnEmpty <> showHelpOnError)+ (info (commands <**> helper) idm)
+ doctest/DoctestDriver.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0)+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}+#else+module Main where++import qualified System.IO as IO++main :: IO ()+main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4"+#endif
+ hw-simd-cli.cabal view
@@ -0,0 +1,140 @@+cabal-version: 2.2++name: hw-simd-cli+version: 0.0.0.1+synopsis: SIMD library+description: Please see the README on Github at <https://github.com/haskell-works/hw-simd-cli#readme>+category: Data, Bit, SIMD+homepage: https://github.com/haskell-works/hw-simd-cli#readme+bug-reports: https://github.com/haskell-works/hw-simd-cli/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2018-2020 John Ky+license: BSD-3-Clause+license-file: LICENSE+tested-with: GHC == 8.10.2, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4+build-type: Simple+extra-source-files: ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-simd-cli++flag avx2+ description: Enable avx2 instruction set+ manual: False+ default: False++flag bmi2+ description: Enable bmi2 instruction set+ manual: False+ default: False++flag sse42+ description: Enable SSE 4.2 optimisations.+ manual: False+ default: True++common base { build-depends: base >= 4.11 && < 5 }++common bits-extra { build-depends: bits-extra >= 0.0.1.2 && < 0.1 }+common bytestring { build-depends: bytestring >= 0.10 && < 0.11 }+common containers { build-depends: containers }+common deepseq { build-depends: deepseq >= 1.4 && < 1.5 }+common directory { build-depends: directory >= 1.2 && < 1.4 }+common doctest { build-depends: doctest >= 0.16.2 && < 0.19 }+common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 }+common generic-lens { build-depends: generic-lens >= 1.2 && < 2.1 }+common hw-bits { build-depends: hw-bits >= 0.7.0.2 && < 0.8 }+common hw-prim { build-depends: hw-prim >= 0.6.2.8 && < 0.7 }+common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2 && < 0.4 }+common hw-simd { build-depends: hw-simd >= 0.1.0.0 && < 0.2 }+common hw-simd-cli { build-depends: hw-simd-cli }+common lens { build-depends: lens }+common mmap { build-depends: mmap >= 0.5.9 && < 0.6 }+common mtl { build-depends: mtl }+common optparse-applicative { build-depends: optparse-applicative }+common resourcet { build-depends: resourcet }+common transformers { build-depends: transformers >= 0.4 && < 0.6 }+common vector { build-depends: vector >= 0.12.0.1 && < 0.13 }++common config+ ghc-options: -Wall+ default-language: Haskell2010+ if flag(sse42)+ ghc-options: -msse4.2+ if (flag(bmi2)) && (impl(ghc >= 8.4.1))+ ghc-options: -mbmi2 -msse4.2+ if (flag(avx2)) && (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++library+ import: base, config+ , bits-extra+ , bytestring+ , containers+ , deepseq+ , directory+ , generic-lens+ , hw-bits+ , hw-prim+ , hw-rankselect-base+ , hw-simd+ , lens+ , mmap+ , mtl+ , optparse-applicative+ , resourcet+ , vector+ exposed-modules: HaskellWorks.Simd.Cli.ChunkData+ HaskellWorks.Simd.Cli.Comparison+ HaskellWorks.Simd.Cli.CutCursor+ other-modules: Paths_hw_simd_cli+ autogen-modules: Paths_hw_simd_cli+ hs-source-dirs: src++executable hw-simd+ import: base, config+ , bits-extra+ , bytestring+ , containers+ , deepseq+ , directory+ , generic-lens+ , hw-bits+ , hw-prim+ , hw-rankselect-base+ , hw-simd+ , hw-simd-cli+ , lens+ , mmap+ , mtl+ , optparse-applicative+ , resourcet+ , vector+ main-is: Main.hs+ other-modules: App.Char+ App.Commands+ App.Commands.Cat+ App.Commands.Chunks+ App.Commands.CmpEq8s+ App.Commands.Cut+ App.Commands.Options.Type+ App.Commands.Wc+ App.IO+ hs-source-dirs: app+ ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N++test-suite doctest+ import: base, config+ , doctest+ , doctest-discover+ , bits-extra+ type: exitcode-stdio-1.0+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ main-is: DoctestDriver.hs+ HS-Source-Dirs: doctest+ build-tool-depends: doctest-discover:doctest-discover
+ src/HaskellWorks/Simd/Cli/ChunkData.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module HaskellWorks.Simd.Cli.ChunkData where++import Control.Lens+import Data.Generics.Product.Any+import GHC.Generics++import qualified Data.ByteString as BS+import qualified Data.Map as M++data ChunkData = ChunkData+ { count :: Int+ , sizes :: M.Map Int Int+ } deriving (Show, Generic)++instance Semigroup ChunkData where+ a <> b = ChunkData+ { count = a ^. the @"count" + b ^. the @"count"+ , sizes = M.unionWith (+) (a ^. the @"sizes") (b ^. the @"sizes")+ }++instance Monoid ChunkData where+ mempty = ChunkData 0 M.empty++chunkDataOf :: BS.ByteString -> ChunkData+chunkDataOf bs = ChunkData+ { count = 1+ , sizes = M.singleton (BS.length bs) 1+ }
+ src/HaskellWorks/Simd/Cli/Comparison.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Simd.Cli.Comparison+ ( CmpEqWord8s(..)+ ) where++import Data.ByteString as BS+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.ByteString as BS+import qualified HaskellWorks.Data.Length as HW++class CmpEqWord8s a where+ cmpEqWord8s :: Word8 -> a -> a++instance CmpEqWord8s BS.ByteString where+ cmpEqWord8s w8 bs = BS.toByteString $ DVS.constructN ((BS.length bs + 7) `div` 8) (go 0 0)+ where go :: Word8 -> Count -> DVS.Vector Word8 -> Word8+ go w n u = case HW.length u of+ ui -> case ui * 8 of+ bsi -> if bsi + 8 <= HW.length bs+ then goFast w n u+ else goSafe w n u+ goFast :: Word8 -> Count -> DVS.Vector Word8 -> Word8+ goFast w n u = if n < 8+ then case HW.length u of+ ui -> case ui * 8 of+ bsi -> case bsi + n of+ wi -> if w8 == bs !!! fromIntegral wi+ then goFast (w .|. (1 .<. n)) (n + 1) u+ else goFast w (n + 1) u+ else w+ goSafe :: Word8 -> Count -> DVS.Vector Word8 -> Word8+ goSafe w n u = if n < 8+ then case HW.length u of+ ui -> case ui * 8 of+ bsi -> case bsi + n of+ wi -> if wi < bsLen+ then if w8 == bs !!! fromIntegral wi+ then goSafe (w .|. (1 .<. n)) (n + 1) u+ else goSafe w (n + 1) u+ else w+ else w+ bsLen = HW.length bs+ {-# INLINE cmpEqWord8s #-}++instance CmpEqWord8s [BS.ByteString] where+ cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs+ {-# INLINE cmpEqWord8s #-}++instance CmpEqWord8s LBS.ByteString where+ cmpEqWord8s w8 = LBS.fromChunks . cmpEqWord8s w8 . LBS.toChunks+ {-# INLINE cmpEqWord8s #-}
+ src/HaskellWorks/Simd/Cli/CutCursor.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}++module HaskellWorks.Simd.Cli.CutCursor+ ( CutCursor(..)+ ) where++import Data.Word+import GHC.Generics++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS++data CutCursor = CutCursor+ { text :: !LBS.ByteString+ , markers :: ![DVS.Vector Word64]+ , newlines :: ![DVS.Vector Word64]+ , position :: !Word64+ } deriving Generic