diff --git a/benchmarks/Benchmark.hs b/benchmarks/Benchmark.hs --- a/benchmarks/Benchmark.hs +++ b/benchmarks/Benchmark.hs @@ -22,7 +22,10 @@ main :: IO () main = do - mb <- getArgs >>= readIO . head + args <- getArgs + mb <- case args of + (arg:_) -> readIO arg + _ -> return 100 memBench (mb*10) putStrLn "" putStrLn "Binary (de)serialisation benchmarks:" diff --git a/benchmarks/Get.hs b/benchmarks/Get.hs --- a/benchmarks/Get.hs +++ b/benchmarks/Get.hs @@ -29,18 +29,17 @@ main :: IO () main = do evaluate $ rnf [ -#if defined(ALTERNATIVE) - -- rnf brackets, -#endif - rnf oneMegabyte - -- rnf oneMegabyteLBS] + rnf brackets, + rnf oneMegabyte, + rnf oneMegabyteLBS ] defaultMain [ -#if defined(ALTERNATIVE) - bench "brackets 100k" $ whnf (runTest bracketParser) brackets, -#endif - bench "getStruct4 1MB struct of 4 word32 strict" $ + bench "brackets 100k one chunk input" $ + whnf (runTest bracketParser) brackets + , bench "brackets 100k in 1024 100 byte chunks" $ + whnf (runTest bracketParser) bracketsInChunks + , bench "getStruct4 1MB struct of 4 word32 strict" $ whnf (runTest (getStruct4Strict mega)) oneMegabyteLBS , bench "getStruct4 1MB struct of 4 word32" $ whnf (runTest (getStruct4 mega)) oneMegabyteLBS @@ -77,10 +76,10 @@ mega = 1024 * 1024 -- 100k of brackets -#if defined(ALTERNATIVE) bracketTest inp = runTest bracketParser inp brackets = L.fromChunks [C8.concat (replicate 1024 "((()((()()))((()(()()()()()()()(((()()()()(()()(()(()())))))()((())())))()())(((())())(()))))()(()))")] +bracketsInChunks = L.fromChunks (replicate 1024 "((()((()()))((()(()()()()()()()(((()()()()(()()(()(()())))))()((())())))()())(((())())(()))))()(()))") bracketParser = cont <|> end where @@ -90,7 +89,6 @@ 41 <- getWord8 return $! n + 1) return $! sum v -#endif -- Struct strict diff --git a/benchmarks/Makefile b/benchmarks/Makefile --- a/benchmarks/Makefile +++ b/benchmarks/Makefile @@ -20,7 +20,7 @@ $(ghc) $(ghc-flags) --make -O2 -fliberate-case-threshold=1000 Benchmark.hs CBenchmark.o -o $@ -fforce-recomp -i../src system-bench: Benchmark.hs MemBench.hs CBenchmark.o - $(ghc) $(ghc-flags) --make -O2 -fliberate-case-threshold=1000 Benchmark.hs CBenchmark.o -o $@ -fforce-recomp -no-user-package-conf + $(ghc) $(ghc-flags) --make -O2 -fliberate-case-threshold=1000 Benchmark.hs CBenchmark.o -o $@ -no-user-package-conf .PHONY: run-bench run-bench: bench diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.6.1.0 +version: 0.6.2.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin @@ -57,8 +57,44 @@ test-framework-quickcheck2, QuickCheck>=2.5 - if flag(development) - ghc-options: -Wall - hs-source-dirs: src - else - build-depends: binary + ghc-options: -Wall + hs-source-dirs: src + +benchmark bench + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: Benchmark.hs + build-depends: + base >= 3.0 && < 5, + binary, + bytestring + c-sources: benchmarks/CBenchmark.c + include-dirs: benchmarks + ghc-options: -O2 + +benchmark get + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: Get.hs + build-depends: + base >= 3.0 && < 5, + binary, + bytestring, + criterion, + deepseq, + mtl + ghc-options: -O2 + +benchmark builder + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: Builder.hs + build-depends: + base >= 3.0 && < 5, + binary, + bytestring, + criterion, + deepseq, + mtl + ghc-options: -O2 + diff --git a/src/Data/Binary.hs b/src/Data/Binary.hs --- a/src/Data/Binary.hs +++ b/src/Data/Binary.hs @@ -7,23 +7,23 @@ -- Module : Data.Binary -- Copyright : Lennart Kolmodin -- License : BSD3-style (see LICENSE) --- +-- -- Maintainer : Lennart Kolmodin -- Stability : unstable -- Portability : portable to Hugs and GHC. Requires the FFI and some flexible instances -- --- Binary serialisation of Haskell values to and from lazy ByteStrings. +-- Binary serialisation of Haskell values to and from lazy 'ByteString's. -- The Binary library provides methods for encoding Haskell values as --- streams of bytes directly in memory. The resulting @ByteString@ can --- then be written to disk, sent over the network, or futher processed +-- streams of bytes directly in memory. The resulting 'ByteString' can +-- then be written to disk, sent over the network, or further processed -- (for example, compressed with gzip). -- --- The 'Binary' package is notable in that it provides both pure, and +-- The @Binary@ package is notable in that it provides both pure, and -- high performance serialisation. -- -- Values are always encoded in network order (big endian) form, and --- encoded data should be portable across machine endianess, word size, --- or compiler version. For example, data encoded using the Binary class +-- encoded data should be portable across machine endianness, word size, +-- or compiler version. For example, data encoded using the 'Binary' class -- could be written from GHC, and read back in Hugs. -- ----------------------------------------------------------------------------- @@ -95,14 +95,14 @@ ------------------------------------------------------------------------ --- | The @Binary@ class provides 'put' and 'get', methods to encode and --- decode a Haskell value to a lazy ByteString. It mirrors the Read and --- Show classes for textual representation of Haskell types, and is +-- | The 'Binary' class provides 'put' and 'get', methods to encode and +-- decode a Haskell value to a lazy 'ByteString'. It mirrors the 'Read' and +-- 'Show' classes for textual representation of Haskell types, and is -- suitable for serialising Haskell values to disk, over the network. -- -- For decoding and generating simple external binary formats (e.g. C -- structures), Binary may be used, but in general is not suitable --- for complex protocols. Instead use the Put and Get primitives +-- for complex protocols. Instead use the 'Put' and 'Get' primitives -- directly. -- -- Instances of Binary should satisfy the following property: @@ -214,7 +214,7 @@ -- > OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2)) -- -- We can also directly serialise a value to and from a Handle, or a file: --- +-- -- > > v <- decodeFile "/tmp/exp.txt" :: IO Exp -- > OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2)) -- @@ -265,7 +265,7 @@ -- -- After contructing the data from the input file, 'decodeFile' checks -- if the file is empty, and in doing so will force the associated file --- handle closed, if it is indeed empty. If the file is not empty, +-- handle closed, if it is indeed empty. If the file is not empty, -- it is up to the decoding instance to consume the rest of the data, -- or otherwise finalise the resource. -- @@ -276,7 +276,7 @@ m <- isEmpty m `seq` return v) s --- needs bytestring 0.9.1.x to work +-- needs bytestring 0.9.1.x to work ------------------------------------------------------------------------ -- Lazy put and get @@ -423,7 +423,7 @@ -- TODO This instance is not architecture portable. GMP stores numbers as -- arrays of machine sized words, so the byte format is not portable across --- architectures with different endianess and word size. +-- architectures with different endianness and word size. import Data.ByteString.Base (toForeignPtr,unsafePackAddress, memcpy) import GHC.Base hiding (ord, chr) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -147,7 +147,7 @@ Nothing -> go (k Nothing) acc Just i -> go (k ms) (acc + fromIntegral (B.length i)) I.BytesRead unused k -> - go (k (acc - unused)) acc + go (k $! (acc - unused)) acc -- | DEPRECATED. Provides compatibility with previous versions of this library. -- Run a 'Get' monad and return a tuple with thee values. diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -205,24 +205,23 @@ Fail inp' _str -> runCont g inp' ks BytesRead unused k -> BytesRead unused (go . k) in go r0 + some p = (:) <$> p <*> many p + many p = do + v <- (Just <$> p) <|> pure Nothing + case v of + Nothing -> pure [] + Just x -> (:) x <$> many p -- | Try to execute a Get. If it fails, the consumed input will be restored. try :: Get a -> Get a try g = C $ \inp ks -> - let r0 = runGetIncremental g `feed` inp + let r0 = runCont g inp (\inp' a -> Done inp' a) go !acc r = case r of Done inp' a -> ks inp' a Partial k -> Partial $ \minp -> go (maybe acc (:acc) minp) (k minp) Fail _ s -> Fail (B.concat (inp : reverse acc)) s BytesRead unused k -> BytesRead unused (go acc . k) in go [] r0 - where - feed r inp = - case r of - Done inp0 a -> Done (inp0 `B.append` inp) a - Partial k -> k (Just inp) - Fail inp0 s -> Fail (inp0 `B.append` inp) s - BytesRead unused k -> BytesRead unused (\i -> k i `feed` inp) -- | DEPRECATED. Get the number of bytes of remaining input. -- Note that this is an expensive function to use as in order to calculate how