buffer-builder (empty) → 0.1.0.0
raw patch · 7 files changed
+399/−0 lines, 7 filesdep +HUnitdep +basedep +buffer-buildersetup-changed
Dependencies added: HUnit, base, buffer-builder, bytestring, criterion, mtl, tasty, tasty-hunit, tasty-th
Files
- Data/BufferBuilder.hs +89/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- bench/Bench.hs +77/−0
- buffer-builder.cabal +87/−0
- buffer.cpp +85/−0
- test/Main.hs +29/−0
+ Data/BufferBuilder.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings, MagicHash, UnboxedTuples, BangPatterns, GeneralizedNewtypeDeriving #-}++module Data.BufferBuilder+ ( BufferBuilder+ , runBufferBuilder+ , appendByte+ , appendChar8+ , appendBS+ ) where++import GHC.Base+import GHC.Word+import GHC.Ptr+import GHC.IO+import GHC.ForeignPtr+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import Control.Monad.Reader++data BWHandle'+type BWHandle = Ptr BWHandle'++foreign import ccall unsafe "bw_new" bw_new :: Int -> IO BWHandle+foreign import ccall unsafe "&bw_free" bw_free :: FunPtr (BWHandle -> IO ())+foreign import ccall unsafe "bw_append_byte" bw_append_byte :: BWHandle -> Word8 -> IO ()+foreign import ccall unsafe "bw_append_bs" bw_append_bs :: BWHandle -> Int -> (Ptr Word8) -> IO ()+foreign import ccall unsafe "bw_get_size" bw_get_size :: BWHandle -> IO Int+foreign import ccall unsafe "bw_trim_and_release_address" bw_trim_and_release_address :: BWHandle -> IO (Ptr Word8)++-- | BufferBuilder sequences actions that append to an implicit,+-- growable buffer. Use 'runBufferBuilder' to extract the resulting+-- buffer as a 'BS.ByteString'+newtype BufferBuilder a = BB (ReaderT BWHandle IO a)+ deriving (Functor, Monad, MonadReader BWHandle)++inBW :: IO a -> BufferBuilder a+inBW = BB . lift++initialCapacity :: Int+initialCapacity = 48+-- why 48? it's only 6 64-bit words... yet many small strings should fit.+-- some quantitative analysis would be good.+-- an option to set the initial capacity would be better. :)++-- | Runs a BufferBuilder and extracts its resulting contents as a 'BS.ByteString'+runBufferBuilder :: BufferBuilder () -> BS.ByteString+runBufferBuilder = unsafeDupablePerformIO . runBufferBuilderIO initialCapacity++runBufferBuilderIO :: Int -> BufferBuilder () -> IO BS.ByteString+runBufferBuilderIO !capacity !(BB bw) = do+ handle <- bw_new capacity+ handleFP <- newForeignPtr bw_free handle+ () <- runReaderT bw handle+ size <- bw_get_size handle+ src <- bw_trim_and_release_address handle++ borrowed <- newForeignPtr finalizerFree src+ let bs = BS.fromForeignPtr borrowed 0 size+ touchForeignPtr handleFP+ return bs+++appendByte :: Word8 -- ^ byte to append to the buffer.+ -> BufferBuilder ()+appendByte b = do+ h <- ask+ inBW $ bw_append_byte h b+{-# INLINE appendByte #-}++c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}++-- | Appends a character to the buffer, truncating it to the bottom 8 bits.+appendChar8 :: Char -- ^ character to append to the buffer+ -> BufferBuilder ()+appendChar8 = appendByte . c2w+{-# INLINE appendChar8 #-}++-- | Appends a ByteString to the buffer.+appendBS :: BS.ByteString -- ^ 'BS.ByteString' to append+ -> BufferBuilder ()+appendBS !(BS.PS (ForeignPtr addr _) offset len) = do+ h <- ask+ inBW $ bw_append_bs h len (plusPtr (Ptr addr) offset)+{-# INLINE appendBS #-}+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, IMVU, Chad Austin++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 Chad Austin 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings, BangPatterns, RecordWildCards #-}++import Data.ByteString (ByteString)+import Criterion.Main+import Data.BufferBuilder+import Control.Monad++scheme :: ByteString+scheme = "http"++host :: ByteString+host = "example.com"++path :: ByteString+path = "the/path/goes/here"++buildURL :: Int -> ByteString+buildURL times = runBufferBuilder $ do+ replicateM_ times $ do+ -- Sadly, if you look at the generated code, there are many+ -- continuations (thus indirect jumps, thus inefficient stack+ -- traffic) here. Even though the test strings are constant,+ -- they become ByteString CAFs, and are tag-checked on every+ -- use. However, appendBS followed by appendChar8 are folded+ -- into the same generated function.+ appendBS scheme+ appendBS "://"+ appendBS host+ appendChar8 '/'+ appendBS path+ appendChar8 '?'+ appendBS "key"+ appendChar8 '='+ appendBS "value"+ appendChar8 '?'+ appendBS "otherkey"+ appendChar8 '='+ appendBS "othervalue"+ appendChar8 '#'+ appendBS "hashyhashyhashy"++data Record = Record+ { f1 :: !ByteString+ , f2 :: !ByteString+ , f3 :: !ByteString+ , f4 :: !ByteString+ , f5 :: !ByteString+ , f6 :: !ByteString+ }++encodeType :: Record -> ByteString+encodeType !(Record{..}) = runBufferBuilder $ do+ -- Because the record elements are strict, all of these appendBS+ -- calls are emitted in one long Cmm/x86 function. Can't do much+ -- better than that. :) However, if you look closely, the+ -- BufferWriter handle (accessed through ReaderT) is reloaded from+ -- the stack after all appendBS. In the future, GHC could realize+ -- it's always the same value and only load it once.+ appendBS f1+ appendBS f2+ appendBS f3+ appendBS f4+ appendBS f5+ appendBS f6++recordValue :: Record+recordValue = Record { f1 = "the wheels on the bus go round and round"+ , f2 = "round and round, round and round"+ , f3 = "the seats on the bus go up and down"+ , f4 = "up and down, up and down"+ , f5 = "the doors on the bus go open and shut"+ , f6 = "open and shut, open and shut"+ }++main :: IO ()+main = defaultMain [ bench "buildURL" $ nf buildURL 10+ , bench "encodeRecord" $ nf encodeType recordValue ]
+ buffer-builder.cabal view
@@ -0,0 +1,87 @@+name: buffer-builder+version: 0.1.0.0+synopsis: Library for efficiently building up buffers, one piece at a time+description:++ 'BufferBuilder' is an efficient library for incrementally building+ up 'ByteString's, one chunk at a time. Early benchmarks show it+ is over twice as fast as ByteString Builder, primarily because+ 'BufferBuilder' is built upon an ST-style restricted monad and+ mutable state instead of ByteString Builder's monoidal AST.+ .+ Internally, BufferBuilder is backed by a few C functions.+ Examination of GHC's output shows nearly optimal code generation+ with no intermediate thunks -- and thus, continuation passing and+ its associated indirect jumps and stack traffic only occur when+ BufferBuilder is asked to append a non-strict ByteString.+ .+ I benchmarked four major implementations and benchmarked with the buildURL benchmark:+ .+ * State monad, concatenating ByteStrings: __6.98 us__+ .+ * State monad, ByteString Builder: __2.48 us__+ .+ * Crazy explicit RealWorld baton passing with unboxed state: __28.94 us__ (GHC generated really awful code for this, but see the revision history for the technique)+ .+ * C + FFI + ReaderT: __1.11 us__+ .+ Using BufferBuilder is very simple:+ .+ > import qualified Data.BufferBuilder as BB+ > + > let byteString = BB.runBufferBuilder $ do+ > BB.appendBS "http"+ > BB.appendChar8 '/'+ > BB.appendBS "//"+ ++license: BSD3+license-file: LICENSE+author: Chad Austin+maintainer: chad@chadaustin.me+copyright: IMVU Inc., Chad Austin+category: Data+build-type: Simple+stability: experimental+homepage: https://github.com/chadaustin/buffer-builder+cabal-version: >=1.10++library+ exposed-modules:+ Data.BufferBuilder++ build-depends: base ==4.*+ , bytestring+ , mtl++ default-language: Haskell2010+ ghc-options: -O2 -Wall++ c-sources: buffer.cpp+ cc-options: -O2 -Wall++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -O2 -Wall++ build-depends: base ==4.*+ , buffer-builder+ , tasty+ , tasty-hunit+ , tasty-th+ , HUnit++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -O2 -Wall -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file++ build-depends: base ==4.*+ , bytestring+ , buffer-builder+ , criterion
+ buffer.cpp view
@@ -0,0 +1,85 @@+#include <assert.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++const size_t TRIM_THRESHOLD = 8192; // minimum number of bytes saved to trim++namespace {+ struct BufferWriter {+ unsigned char* data;+ size_t size;+ size_t capacity;+ };+}++// assumes malloc will not fail+// TODO: replace assert with some other error mechanism++extern "C" BufferWriter* bw_new(size_t initialCapacity) {+ assert(initialCapacity >= 1);+ BufferWriter* bw = reinterpret_cast<BufferWriter*>(malloc(sizeof(BufferWriter)));+ assert(bw);+ bw->data = reinterpret_cast<unsigned char*>(malloc(initialCapacity));+ assert(bw->data);+ bw->size = 0;+ bw->capacity = initialCapacity;+ return bw;+}++extern "C" void bw_free(BufferWriter* bw) {+ free(bw->data);+ free(bw);+}++extern "C" void bw_append_byte(BufferWriter* bw, unsigned char byte) {+ assert(bw->data);+ if (bw->size >= bw->capacity) {+ size_t newCapacity = bw->capacity * 2;+ unsigned char* nd = reinterpret_cast<unsigned char*>(realloc(bw->data, newCapacity));+ assert(nd);+ bw->data = nd;+ bw->capacity = newCapacity;+ }++ bw->data[bw->size] = byte;+ bw->size += 1;+}++extern "C" void bw_append_bs(BufferWriter* bw, size_t size, unsigned char* data) {+ assert(bw->data);+ if (bw->size + size > bw->capacity) {+ size_t newCapacity = bw->capacity * 2;+ while (bw->size + size > newCapacity) {+ newCapacity *= 2;+ }+ unsigned char* nd = reinterpret_cast<unsigned char*>(realloc(bw->data, newCapacity));+ assert(nd);+ bw->data = nd;+ bw->capacity = newCapacity;+ }++ memcpy(bw->data + bw->size, data, size);+ bw->size += size;+}++extern "C" size_t bw_get_size(BufferWriter* bw) {+ return bw->size;+}++extern "C" unsigned char* bw_trim_and_release_address(BufferWriter* bw) {+ unsigned char* data = bw->data;+ + if (bw->size + TRIM_THRESHOLD < bw->capacity) {+ // try to shrink+ data = reinterpret_cast<unsigned char*>(realloc(data, bw->size));+ if (!data) {+ // no problem+ data = bw->data;+ }+ }++ bw->data = 0;+ return data;+}+
+ test/Main.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}++import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.HUnit+import Data.BufferBuilder++case_append_bytes :: Assertion+case_append_bytes = do+ let result = runBufferBuilder $ do+ appendChar8 'f'+ appendChar8 'o'+ appendChar8 'o'+ assertEqual "matches" "foo" result++case_append_string :: Assertion+case_append_string = do+ let result = runBufferBuilder $ do+ appendChar8 'f'+ appendChar8 'o'+ appendChar8 'o'+ appendBS "bar"+ assertEqual "matches" "foobar" result++tests :: TestTree+tests = $(testGroupGenerator)++main :: IO ()+main = defaultMain tests