mason 0 → 0.1
raw patch · 4 files changed
+198/−28 lines, 4 files
Files
- README.md +116/−0
- mason.cabal +3/−2
- src/Mason/Builder.hs +16/−3
- src/Mason/Builder/Internal.hs +63/−23
+ README.md view
@@ -0,0 +1,116 @@+mason: alacritous builder library+====++[](https://travis-ci.com/fumieval/mason)+[](https://hackage.haskell.org/package/mason)++mason is a builder & IO library.++* __Fast__: much faster than bytestring's Builder.+* __Extensible__: Builders can be consumed in a user-defined way.+* __Hackable__: Low-level APIs are exposed. It's easy to plug in even pointer-level operations.++`Mason.Builder` has API mostly compatible with `Data.ByteString.Builder` but there are some additions to the original API:++* `toStrictByteString` produces a strict `ByteString` directly.+* `hPutBuilderLen` writes a builder to a handle and returns the number of bytes.+* `sendBuilder` sends the content of `Builder` over a socket.++Usage+----++Replace `Data.ByteString.Builder` with `Mason.Builder`. Note that if you have `Builder` in the type signature, you'll need `RankNTypes` extensions because of the design explained below.++Performance+----++As long as the code is optimised, mason's builder can be very fast (twice or more as bytestring). Make sure that functions returning `Builder`s are well inlined.++Serialisation of JSON-like structure:++```+mason/hPutBuilder mean 274.7 μs ( +- 49.40 μs )+fast-builder/hPutBuilder mean 399.9 μs ( +- 76.05 μs )+bytestring/hPutBuilder mean 335.1 μs ( +- 86.96 μs )+mason/toStrictByteString mean 106.6 μs ( +- 6.680 μs )+fast-builder/toStrictByteString mean 254.8 μs ( +- 31.64 μs )+bytestring/toLazyByteString mean 283.3 μs ( +- 24.26 μs )+mason/toLazyByteString mean 127.2 μs ( +- 25.86 μs )+fast-builder/toLazyByteString mean 249.0 μs ( +- 25.60 μs )+bytestring/toLazyByteString mean 263.4 μs ( +- 9.401 μs )+```++In the same benchmark application, the allocation footprint of mason is feathery.++```+toStrictByteString+mason 291,112 0+fast-builder 991,016 0+bytestring 1,158,584 0 (toStrict . toLazyByteString)++toLazyByteString+Case Allocated GCs+mason 228,936 0+fast-builder 903,752 0+bytestring 1,101,448 0+```++`doubleDec` employs Grisu3 which grants ~20x speedup over `show`-based implementation.++```+mason/double mean 116.2 ns ( +- 6.654 ns )+fast-builder/double mean 2.183 μs ( +- 85.80 ns )+bytestring/double mean 2.312 μs ( +- 118.8 ns )+```++TBD: more benchmarks++Architecture+----++Mason's builder is a function that takes a purpose-dependent environment and a buffer. There is little intermediate structure involved; almost everything runs in one pass. This design is inspired by [fast-builder](http://hackage.haskell.org/package/fast-builder).++```haskell+type Builder = forall s. Buildable s => BuilderFor s++newtype BuilderFor s = Builder { unBuilder :: s -> Buffer -> IO Buffer }++data Buffer = Buffer+ { bEnd :: {-# UNPACK #-} !(Ptr Word8) -- ^ end of the buffer (next to the last byte)+ , bCur :: {-# UNPACK #-} !(Ptr Word8) -- ^ current position+ }++class Buildable s where+ byteString :: B.ByteString -> BuilderFor s+ flush :: BuilderFor s+ allocate :: Int -> BuilderFor s+```++Instances of the `Buildable` class implement purpose-specific behaviour (e.g. exponentially allocate a buffer, flush to disk). This generic interface also allows creative uses of Builders such as on-the-fly compression.++`Builder` has a smart constructor called `ensure`:++```haskell+ensure :: Int -> (Buffer -> IO Buffer) -> Builder+```++`ensure n f` secures at least `n` bytes in the buffer and passes the pointer to `f`. This gives rise to monoid homorphism; namely, `ensure m f <> ensure n g` will fuse into `ensure (m + n) (f >=> g)` so don't worry about the overhead of bound checking.++Creating your own primitives+----++The easiest way to create a new primitive is `withPtr`, a simplified version of `ensure`. This is quite convenient for calling foreign functions or anything low-level.++```haskell+-- | Construct a 'Builder' from a "poke" function.+withPtr :: Int -- ^ number of bytes to allocate (if needed)+ -> (Ptr Word8 -> IO (Ptr Word8)) -- ^ return a next pointer after writing+ -> Builder++grisu v = withPtr 24 $ \ptr -> do+ n <- dtoa_grisu3 v ptr+ return $ plusPtr ptr (fromIntegral n)++foreign import ccall unsafe "static dtoa_grisu3"+ dtoa_grisu3 :: Double -> Ptr Word8 -> IO CInt+```
mason.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: mason-version: 0+version: 0.1 synopsis: Fast and extensible bytestring builder description: See README.md bug-reports: https://github.com/fumieval/mason/issues@@ -11,7 +11,8 @@ maintainer: fumiexcel@gmail.com copyright: 2019 Fumiaki Kinoshita, Don Stewart 2005-2009, Duncan Coutts 2006-2015, David Roundy 2003-2005, Jasper Van der Jeugt 2010, Simon Meier 2010-2013, Ben Gamari 2017 category: Data-extra-source-files: CHANGELOG.md+extra-source-files: CHANGELOG.md, README.md+tested-with: GHC == 8.6.5, GHC==8.8.1 library exposed-modules:
src/Mason/Builder.hs view
@@ -1,6 +1,15 @@ {-# LANGUAGE MagicHash, CPP, UnboxedTuples #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE RankNTypes #-}+----------------------------------------------------------------------------+-- |+-- Module : Mason.Builders+-- Copyright : (c) Fumiaki Kinoshita 2019+-- License : BSD3+--+-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>+--+---------------------------------------------------------------------------- module Mason.Builder ( Builder , BuilderFor@@ -11,13 +20,14 @@ , hPutBuilderLen , hPutBuilder , sendBuilder- -- * Raw+ -- * Primitives , flush , encodeUtf8Builder , encodeUtf8BuilderEscaped , byteString , lazyByteString , shortByteString+ , storable , int8 , word8 , int16LE@@ -73,6 +83,8 @@ , byteStringHex , lazyByteStringHex -- * Advanced+ , padded+ , zeroPadded , primFixed , primBounded , lengthPrefixedWithin@@ -99,6 +111,7 @@ hPutBuilder h b = void $ hPutBuilderLen h b {-# INLINE hPutBuilder #-} +-- | Combine chunks of a lazy 'BL.ByteString' lazyByteString :: BL.ByteString -> Builder lazyByteString = foldMap byteString . BL.toChunks {-# INLINE lazyByteString #-}@@ -299,9 +312,9 @@ | x == 0 = string7 "0.0" | otherwise = grisu x where- grisu v = B.ensure 24 $ \(B.Buffer end ptr) -> do+ grisu v = withPtr 24 $ \ptr -> do n <- dtoa_grisu3 v ptr- return $ B.Buffer end $ plusPtr ptr (fromIntegral n)+ return $ plusPtr ptr (fromIntegral n) foreign import ccall unsafe "static dtoa_grisu3" dtoa_grisu3 :: Double -> Ptr Word8 -> IO CInt
src/Mason/Builder/Internal.hs view
@@ -28,6 +28,10 @@ , SocketEnv(..) , cstring , cstringUtf8+ , withPtr+ , storable+ , padded+ , zeroPadded -- * Internal , ensure , allocateConstant@@ -56,7 +60,7 @@ import Data.IORef import Data.Word (Word8) import Data.String-import qualified Foreign.Storable as S+import Foreign.Storable as S import System.IO.Unsafe import qualified Data.Text.Array as A import qualified Data.Text.Internal as T@@ -75,9 +79,12 @@ -- | Builder specialised for a backend newtype BuilderFor s = Builder { unBuilder :: s -> Buffer -> IO Buffer } +-- | This class is used to provide backend-specific operations for running a 'Builder'. class Buildable s where -- | Put a 'B.ByteString'. byteString :: B.ByteString -> BuilderFor s+ byteString = byteStringCopy+ {-# INLINE byteString #-} -- | Flush the content of the internal buffer. flush :: BuilderFor s -- | Allocate a buffer with at least the given length.@@ -91,19 +98,31 @@ -- | Copy a 'B.ByteString' to a buffer. byteStringCopy :: Buildable s => B.ByteString -> BuilderFor s-byteStringCopy = \(B.PS fsrc ofs len) -> ensure len $ \(Buffer end ptr) -> do+byteStringCopy = \(B.PS fsrc ofs len) -> withPtr len $ \ptr -> do withForeignPtr fsrc $ \src -> B.memcpy ptr (src `plusPtr` ofs) len- return $ Buffer end (ptr `plusPtr` len)+ return $ ptr `plusPtr` len {-# INLINE byteStringCopy #-} -- | Copy a 'SB.ShortByteString' to a buffer. shortByteString :: SB.ShortByteString -> Builder-shortByteString = \src -> let len = SB.length src in ensure len $ \(Buffer end ptr) ->- Buffer end (ptr `plusPtr` len)- <$ SB.copyToPtr src 0 ptr len+shortByteString = \src -> let len = SB.length src in withPtr len $ \ptr ->+ plusPtr ptr len <$ SB.copyToPtr src 0 ptr len {-# INLINE shortByteString #-} --- | Ensure that the given number of bytes is available in the buffer. Subject to semigroup fusions+-- | Construct a 'Builder' from a "poke" function.+withPtr :: Buildable s+ => Int -- ^ number of bytes to allocate (if needed)+ -> (Ptr Word8 -> IO (Ptr Word8)) -- ^ return a next pointer after writing+ -> BuilderFor s+withPtr n f = ensure n $ \(Buffer e p) -> Buffer e <$> f p+{-# INLINE withPtr #-}++-- | Turn a 'Storable' value into a 'Builder'+storable :: Storable a => a -> Builder+storable a = withPtr (sizeOf a) $ \p -> plusPtr p (sizeOf a) <$ poke (castPtr p) a+{-# INLINE storable #-}++-- | Ensure that the given number of bytes is available in the buffer. Subject to semigroup fusion ensure :: Int -> (Buffer -> IO Buffer) -> Builder ensure mlen cont = Builder $ \env buf@(Buffer end ptr) -> if ptr `plusPtr` mlen >= end@@ -199,14 +218,14 @@ fromString = stringUtf8 {-# INLINE fromString #-} +-- | Use 'B.BoundedPrim' primBounded :: B.BoundedPrim a -> a -> Builder-primBounded bp a = ensure (B.sizeBound bp)- $ \(Buffer end ptr) -> Buffer end <$> B.runB bp a ptr+primBounded bp = withPtr (B.sizeBound bp) . B.runB bp {-# INLINE primBounded #-} +-- | Use 'B.FixedPrim' primFixed :: B.FixedPrim a -> a -> Builder-primFixed fp a = ensure (B.size fp)- $ \(Buffer end ptr) -> Buffer end (ptr `plusPtr` B.size fp) <$ B.runF fp a ptr+primFixed fp a = withPtr (B.size fp) $ \ptr -> (ptr `plusPtr` B.size fp) <$ B.runF fp a ptr {-# INLINE primFixed #-} primMapListFixed :: B.FixedPrim a -> [a] -> Builder@@ -225,6 +244,23 @@ primMapLazyByteStringFixed fp = BL.foldr (mappend . primFixed fp) mempty {-# INLINE primMapLazyByteStringFixed #-} +padded :: Word8+ -> Int -- ^ pad if shorter than this+ -> B.BoundedPrim a+ -> a+ -> Builder+padded ch size bp a = ensure (B.sizeBound bp) $ \(Buffer end ptr) -> do+ ptr' <- B.runB bp a ptr+ let len = ptr' `minusPtr` ptr+ let pad = size - len+ when (pad > 0) $ do+ c_memmove (ptr `plusPtr` pad) ptr len+ void $ B.memset ptr ch (fromIntegral pad)+ return $ Buffer end $ ptr' `plusPtr` max pad 0++zeroPadded :: Int -> B.BoundedPrim a -> a -> Builder+zeroPadded = padded 48+ newtype GrowingBuffer = GrowingBuffer (IORef (ForeignPtr Word8)) instance Buildable GrowingBuffer where@@ -244,6 +280,7 @@ return $ Buffer (dst' `plusPtr` size') (dst' `plusPtr` pos) {-# INLINE allocate #-} +-- | Create a strict 'B.ByteString' toStrictByteString :: BuilderFor GrowingBuffer -> B.ByteString toStrictByteString b = unsafePerformIO $ do fptr0 <- mallocForeignPtrBytes initialSize@@ -267,7 +304,7 @@ instance Buildable Channel where byteString bs- | B.length bs < 4096 = byteStringCopy bs+ | B.length bs < 3272 = byteStringCopy bs | otherwise = flush <> Builder (\(Channel v _) b -> b <$ putMVar v bs) {-# INLINE byteString #-} flush = Builder $ \(Channel v ref) (Buffer end ptr) -> do@@ -279,19 +316,19 @@ allocate = allocateConstant chBuffer {-# INLINE allocate #-} +-- | Create a lazy 'BL.ByteString'. Threaded runtime is required. toLazyByteString :: BuilderFor Channel -> BL.ByteString toLazyByteString body = unsafePerformIO $ do resp <- newEmptyMVar - let initialSize = 4096- fptr <- mallocForeignPtrBytes initialSize+ fptr <- mallocForeignPtrBytes defaultBufferSize ref <- newIORef fptr let ptr = unsafeForeignPtrToPtr fptr let final (Left e) = throw e final (Right _) = putMVar resp B.empty _ <- flip forkFinally final $ unBuilder (body <> flush) (Channel resp ref)- $ Buffer (ptr `plusPtr` initialSize) ptr+ $ Buffer (ptr `plusPtr` defaultBufferSize) ptr let go _ = unsafePerformIO $ do bs <- takeMVar resp@@ -301,6 +338,7 @@ return $ go () {-# INLINE toLazyByteString #-} +-- | Environemnt for handle output data PutBuilderEnv = PBE { pbHandle :: !Handle , pbBuffer :: !(IORef (ForeignPtr Word8))@@ -318,7 +356,7 @@ instance Buildable PutBuilderEnv where byteString bs- | len > 4096 = mappend flush $ Builder $ \(PBE h _ _) buf -> do+ | len > defaultBufferSize = mappend flush $ Builder $ \(PBE h _ _) buf -> do B.hPut h bs return buf | otherwise = byteStringCopy bs@@ -337,20 +375,23 @@ allocate = allocateConstant pbBuffer {-# INLINE allocate #-} +defaultBufferSize :: Int+defaultBufferSize = 2048+ -- | Write a 'Builder' into a handle and obtain the number of bytes written. -- 'flush' does not imply actual disk operations. Set 'NoBuffering' if you want -- it to write the content immediately. hPutBuilderLen :: Handle -> BuilderFor PutBuilderEnv -> IO Int hPutBuilderLen h b = do- let initialSize = 4096- fptr <- mallocForeignPtrBytes initialSize+ fptr <- mallocForeignPtrBytes defaultBufferSize ref <- newIORef fptr let ptr = unsafeForeignPtrToPtr fptr counter <- newIORef 0- _ <- unBuilder (b <> flush) (PBE h ref counter) (Buffer (ptr `plusPtr` initialSize) ptr)+ _ <- unBuilder (b <> flush) (PBE h ref counter) (Buffer (ptr `plusPtr` defaultBufferSize) ptr) readIORef counter {-# INLINE hPutBuilderLen #-} +-- | Environemnt for socket output data SocketEnv = SE { seSocket :: !S.Socket , seBuffer :: !(IORef (ForeignPtr Word8))@@ -368,7 +409,7 @@ instance Buildable SocketEnv where byteString bs- | len > 4096 = mappend flush $ Builder $ \(SE sock _ _) (Buffer end ptr) -> do+ | len > defaultBufferSize = mappend flush $ Builder $ \(SE sock _ _) (Buffer end ptr) -> do S.sendAll sock bs return $! Buffer end ptr | otherwise = byteStringCopy bs@@ -388,12 +429,11 @@ -- | Write a 'Builder' into a handle and obtain the number of bytes written. sendBuilder :: S.Socket -> BuilderFor SocketEnv -> IO Int sendBuilder sock b = do- let initialSize = 4096- fptr <- mallocForeignPtrBytes initialSize+ fptr <- mallocForeignPtrBytes defaultBufferSize ref <- newIORef fptr let ptr = unsafeForeignPtrToPtr fptr counter <- newIORef 0- _ <- unBuilder (b <> flush) (SE sock ref counter) (Buffer (ptr `plusPtr` initialSize) ptr)+ _ <- unBuilder (b <> flush) (SE sock ref counter) (Buffer (ptr `plusPtr` defaultBufferSize) ptr) readIORef counter {-# INLINE sendBuilder #-}