hw-dump (empty) → 0.0.0.1
raw patch · 16 files changed
+551/−0 lines, 16 filesdep +QuickCheckdep +basedep +bits-extrasetup-changed
Dependencies added: QuickCheck, base, bits-extra, bytestring, criterion, hedgehog, hspec, hw-bits, hw-dump, hw-hspec-hedgehog, hw-prim, lens, optparse-applicative, safe, vector
Files
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- app/App/Commands.hs +15/−0
- app/App/Commands/Bits.hs +87/−0
- app/App/Commands/Options/Lens.hs +15/−0
- app/App/Commands/Options/Type.hs +22/−0
- app/App/Commands/SelectedByBits.hs +65/−0
- app/App/Commands/Slice.hs +69/−0
- app/App/Commands/Words.hs +61/−0
- app/Main.hs +11/−0
- bench/Main.hs +30/−0
- hw-dump.cabal +119/−0
- src/HaskellWorks/Data/Dump.hs +1/−0
- test/HaskellWorks/Data/Dump/DumpSpec.hs +18/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2017++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 Author name here 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,5 @@+# hw-dump++[](https://circleci.com/gh/haskell-works/hw-dump)++Facilities for dump bits in files.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App/Commands.hs view
@@ -0,0 +1,15 @@+module App.Commands where++import App.Commands.Bits+import App.Commands.SelectedByBits+import App.Commands.Slice+import App.Commands.Words+import Data.Semigroup ((<>))+import Options.Applicative++cmdOpts :: Parser (IO ())+cmdOpts = subparser $ mempty+ <> cmdBits+ <> cmdSelectedByBits+ <> cmdSlice+ <> cmdWords
+ app/App/Commands/Bits.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.Bits+ ( cmdBits+ ) where++import App.Commands.Options.Type+import Control.Lens+import Control.Monad+import Data.Char (isAscii, isPrint)+import Data.List (transpose)+import Data.Semigroup ((<>))+import HaskellWorks.Data.Bits.BitShow+import Numeric (showHex)+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Lens as L+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as C8+import qualified System.IO as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++lazyByteStringChunks :: Int -> LBS.ByteString -> [LBS.ByteString]+lazyByteStringChunks n bs = case LBS.splitAt (fromIntegral n) bs of+ (lbs, rbs) -> if LBS.length rbs > 0+ then lbs:lazyByteStringChunks n rbs+ else if LBS.length lbs > 0+ then [lbs]+ else []++zap :: [a] -> [[b]] -> [(a, [b])]+zap (a:as) (b:bs) = (a, b):(zap as bs)+zap (a:as) _ = (a, []):(zap as [])+zap _ _ = []++isAsciiPrintable :: Char -> Bool+isAsciiPrintable c = isPrint c && isAscii c++maskNonAsciiPrintable :: Char -> Char+maskNonAsciiPrintable c = if isAsciiPrintable c then c else '.'++runBits :: BitsOptions -> IO ()+runBits opts = do+ let file = opts ^. L.file+ let bitFiles = opts^. L.bitFiles++ chunkedContents <- lazyByteStringChunks 64 <$> LBS.readFile file+ chunkedBitContents <- forM bitFiles $ (lazyByteStringChunks 8 <$>) . LBS.readFile++ forM_ (zap (zip [0..] chunkedContents) (transpose chunkedBitContents)) $ \((i :: Int, as), bss) -> do+ IO.putStr (reverse (take 8 (reverse ((("00000000" ++) . showHex i) ""))))+ IO.putStr " "+ let css = lazyByteStringChunks 8 as+ forM_ css $ \cs -> do+ IO.putStr " "+ IO.putStr (maskNonAsciiPrintable <$> C8.unpack cs)+ IO.putStrLn ""+ forM_ bss $ \bs -> do+ IO.putStr " "+ forM_ (zip css (LBS.unpack bs)) $ \(cs, b) -> do+ IO.putStr " "+ IO.putStr $ take (fromIntegral (LBS.length cs)) (bitShow b)+ IO.putStrLn ""+ IO.putStrLn ""+ return ()++ return ()++optsBits :: Parser BitsOptions+optsBits = BitsOptions+ <$> strOption+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> many+ ( strOption+ ( long "bit-file"+ <> help "Bit file"+ <> metavar "FILE"+ )+ )++cmdBits :: Mod CommandFields (IO ())+cmdBits = command "bits" $ flip info idm $ runBits <$> optsBits
+ app/App/Commands/Options/Lens.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++module App.Commands.Options.Lens where++import App.Commands.Options.Type+import Control.Lens++makeFields ''BitsOptions+makeFields ''SelectedByBitsOptions+makeFields ''SliceOptions+makeFields ''WordsOptions
+ app/App/Commands/Options/Type.hs view
@@ -0,0 +1,22 @@+module App.Commands.Options.Type where++data BitsOptions = BitsOptions+ { _bitsOptionsFile :: FilePath+ , _bitsOptionsBitFiles :: [FilePath]+ } deriving (Eq, Show)++data SelectedByBitsOptions = SelectedByBitsOptions+ { _selectedByBitsOptionsFile :: FilePath+ , _selectedByBitsOptionsBitFile :: FilePath+ } deriving (Eq, Show)++data SliceOptions = SliceOptions+ { _sliceOptionsFile :: FilePath+ , _sliceOptionsWordSize :: Int+ , _sliceOptionsWordIndex :: Int+ } deriving (Eq, Show)++data WordsOptions = WordsOptions+ { _wordsOptionsFile :: FilePath+ , _wordsOptionsWordSize :: Int+ } deriving (Eq, Show)
+ app/App/Commands/SelectedByBits.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.SelectedByBits+ ( cmdSelectedByBits+ ) where++import App.Commands.Options.Type+import Control.Lens+import Control.Monad+import Data.Bits (countTrailingZeros)+import Data.Semigroup ((<>))+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Lens as L+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.ByteString.Lazy as LBS+import qualified HaskellWorks.Data.Vector.AsVector64 as DVS+import qualified System.IO as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++selectedBytes :: BS.ByteString -> BS.ByteString -> B.Builder+selectedBytes as bs = go (DVS.head (DVS.asVector64 bs)) mempty+ where go :: Word64 -> B.Builder -> B.Builder+ go w b = if w /= 0+ then let i = countTrailingZeros w in+ go (w .&. (0xfffffffffffffffe .<. fromIntegral i)) (b <> B.word8 (BS.unsafeIndex as i))+ else b++runSelectedByBits :: SelectedByBitsOptions -> IO ()+runSelectedByBits opts = do+ let file = opts ^. L.file+ let bitFile = opts ^. L.bitFile++ chunkedContents <- LBS.toChunks . LBS.rechunkPadded 64 <$> LBS.readFile file+ chunkedBitContents <- LBS.toChunks . LBS.rechunkPadded 8 <$> LBS.readFile bitFile++ forM_ (zip chunkedContents chunkedBitContents) $ \(byteChunk, bitChunk) -> do+ B.hPutBuilder IO.stdout $ selectedBytes byteChunk bitChunk++ return ()++optsSelectedByBits :: Parser SelectedByBitsOptions+optsSelectedByBits = SelectedByBitsOptions+ <$> strOption+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> strOption+ ( long "bit-file"+ <> help "Bit file"+ <> metavar "FILE"+ )++cmdSelectedByBits :: Mod CommandFields (IO ())+cmdSelectedByBits = command "selected-by-bits" $ flip info idm $ runSelectedByBits <$> optsSelectedByBits+
+ app/App/Commands/Slice.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.Slice+ ( cmdSlice+ ) where++import App.Commands.Options.Type+import Control.Lens+import Control.Monad+import Data.Bits.Pext+import Data.Semigroup ((<>))+import Data.Word+import HaskellWorks.Data.Vector.AsVector64+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Lens as L+import qualified Data.ByteString.Builder as B+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.ByteString.Lazy as LBS+import qualified System.IO as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++runSlice :: SliceOptions -> IO ()+runSlice opts = do+ let file = opts ^. L.file+ let wordIndex = opts ^. L.wordIndex+ let wordSize = opts ^. L.wordSize++ case (wordSize, wordIndex) of+ (2, 0) -> do+ vs <- fmap asVector64 . LBS.toChunks . LBS.resegment 8 <$> LBS.readFile file++ forM_ vs $ \v -> do+ let u = DVS.map (\w -> fromIntegral (pext w 0x5555555555555555) :: Word32) v+ B.hPutBuilder IO.stdout $ B.byteString (BS.toByteString u)+ (2, 1) -> do+ vs <- fmap asVector64 . LBS.toChunks . LBS.resegment 8 <$> LBS.readFile file++ forM_ vs $ \v -> do+ let u = DVS.map (\w -> fromIntegral (pext w 0xaaaaaaaaaaaaaaaa) :: Word32) v+ B.hPutBuilder IO.stdout $ B.byteString (BS.toByteString u)+ config -> error $ "Unsupported slice config: " <> show config++ return ()++optsSlice :: Parser SliceOptions+optsSlice = SliceOptions+ <$> strOption+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> option auto+ ( long "word-size"+ <> help "Word size"+ <> metavar "INT"+ )+ <*> option auto+ ( long "word-bit"+ <> help "Word bit"+ <> metavar "INT"+ )++cmdSlice :: Mod CommandFields (IO ())+cmdSlice = command "slice" $ flip info idm $ runSlice <$> optsSlice
+ app/App/Commands/Words.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ScopedTypeVariables #-}++module App.Commands.Words+ ( cmdWords+ ) where++import App.Commands.Options.Type+import Control.Lens+import Control.Monad+import Data.Semigroup ((<>))+import Data.Word+import Numeric (showHex)+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Lens as L+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.FromForeignRegion as IO+import qualified System.IO as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++printWords64 :: DVS.Vector Word64 -> IO ()+printWords64 v = do+ forM_ [0 .. DVS.length v - 1] $ \i -> do+ IO.putStr $ reverse (take 8 (reverse ((("00000000" ++) . showHex i) "")))+ IO.putStr " "+ IO.putStr $ reverse (take 16 (reverse ((("0000000000000000" ++) . showHex (v DVS.! i)) "")))+ IO.putStr " "+ IO.putStr $ show (v DVS.! i)+ IO.putStrLn ""+ return ()++ return ()++runWords :: WordsOptions -> IO ()+runWords opts = do+ let file = opts ^. L.file+ let wordSize = opts^. L.wordSize++ case wordSize of+ 64 -> IO.mmapFromForeignRegion file >>= printWords64+ n -> IO.hPutStrLn IO.stderr $ "Unsupported word size: " <> show n++ return ()++optsWords :: Parser WordsOptions+optsWords = WordsOptions+ <$> strOption+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> option auto+ ( long "word-size"+ <> help "Word size"+ <> metavar "INT"+ )++cmdWords :: Mod CommandFields (IO ())+cmdWords = command "words" $ flip info idm $ runWords <$> optsWords
+ 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 (cmdOpts <**> helper) idm)
+ bench/Main.hs view
@@ -0,0 +1,30 @@+module Main where++import Criterion.Main+import Data.Word+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Bits.Types.Broadword+import HaskellWorks.Data.Bits.Types.Builtin++import qualified Data.Vector.Storable as DVS++setupEnvVector :: Int -> IO (DVS.Vector Word64)+setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))++benchPopCount1 :: [Benchmark]+benchPopCount1 =+ [ env (setupEnvVector 1000000) $ \bv -> bgroup "PopCount0"+ [ bench "Broadword" (nf (map (\n -> popCount0 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector (Broadword Word64))))) [0, 1000..100000])+ , bench "Builtin" (nf (map (\n -> popCount0 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector (Builtin Word64))))) [0, 1000..100000])+ , bench "Default" (nf (map (\n -> popCount0 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector Word64 )))) [0, 1000..100000])+ ]+ , env (setupEnvVector 1000000) $ \bv -> bgroup "PopCount1"+ [ bench "Broadword" (nf (map (\n -> popCount1 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector (Broadword Word64))))) [0, 1000..100000])+ , bench "Builtin" (nf (map (\n -> popCount1 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector (Builtin Word64))))) [0, 1000..100000])+ , bench "Default" (nf (map (\n -> popCount1 (DVS.take n (DVS.unsafeCast bv :: DVS.Vector Word64 )))) [0, 1000..100000])+ ]+ ]++main :: IO ()+main = defaultMain benchPopCount1
+ hw-dump.cabal view
@@ -0,0 +1,119 @@+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack++name: hw-dump+version: 0.0.0.1+synopsis: File Dump+description: Please see README.md+category: Data, Bit+stability: Experimental+homepage: http://github.com/haskell-works/hw-dump#readme+bug-reports: https://github.com/haskell-works/hw-dump/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-dump++flag sse42+ description: Enable SSE 4.2 optimisations.+ manual: False+ default: True++library+ hs-source-dirs:+ src+ build-depends:+ base >= 4 && < 5+ , bits-extra+ , bytestring+ , hw-bits >= 0.7.0.3+ , hw-prim >= 0.6.2.19+ , vector+ , safe+ if flag(sse42)+ ghc-options: -Wall -O2 -msse4.2+ else+ ghc-options: -Wall -O2+ exposed-modules:+ HaskellWorks.Data.Dump+ other-modules:+ Paths_hw_dump+ default-language: Haskell2010++executable hw-dump+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2+ build-depends:+ base >= 4 && < 5+ , bits-extra+ , bytestring+ , hw-bits >= 0.7.0.3+ , hw-prim >= 0.6.2.19+ , vector+ , hw-dump+ , lens+ , optparse-applicative+ other-modules:+ App.Commands+ App.Commands.Bits+ App.Commands.Options.Lens+ App.Commands.Options.Type+ App.Commands.SelectedByBits+ App.Commands.Slice+ App.Commands.Words+ default-language: Haskell2010++test-suite hw-dump-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base >= 4 && < 5+ , bits-extra+ , bytestring+ , hw-bits >= 0.7.0.3+ , hw-prim >= 0.6.2.19+ , vector+ , hedgehog+ , hspec+ , hw-dump+ , hw-hspec-hedgehog+ , QuickCheck+ other-modules:+ HaskellWorks.Data.Dump.DumpSpec+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ bench+ build-depends:+ base >= 4 && < 5+ , bits-extra+ , bytestring+ , hw-bits >= 0.7.0.3+ , hw-prim >= 0.6.2.19+ , vector+ , criterion+ , hw-dump+ if flag(sse42)+ ghc-options: -Wall -O2 -msse4.2+ else+ ghc-options: -Wall -O2+ default-language: Haskell2010
+ src/HaskellWorks/Data/Dump.hs view
@@ -0,0 +1,1 @@+module HaskellWorks.Data.Dump where
+ test/HaskellWorks/Data/Dump/DumpSpec.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Dump.DumpSpec (spec) where++import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.DumpSpec" $ do+ it "Empty" $ requireTest $ do+ True === True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}