buffer-builder 0.1.0.0 → 0.2.0.0
raw patch · 12 files changed
+1658/−98 lines, 12 filesdep +aesondep +attoparsecdep +deepseqdep ~base
Dependencies added: aeson, attoparsec, deepseq, tasty-quickcheck, text, unordered-containers, vector
Dependency ranges changed: base
Files
- Data/BufferBuilder.hs +208/−30
- Data/BufferBuilder/Json.hs +324/−0
- Data/BufferBuilder/Utf8.hs +174/−0
- LICENSE +1/−1
- bench/Bench.hs +22/−1
- bench/JsonBench.hs +289/−0
- bench/TinyJson.hs +28/−0
- bench/TinyJson2.hs +17/−0
- branchlut.cpp +275/−0
- buffer-builder.cabal +74/−12
- buffer.cpp +235/−31
- test/Main.hs +11/−23
Data/BufferBuilder.hs view
@@ -1,11 +1,43 @@ {-# LANGUAGE OverloadedStrings, MagicHash, UnboxedTuples, BangPatterns, GeneralizedNewtypeDeriving #-} -module Data.BufferBuilder- ( BufferBuilder+{-|+A library for efficiently building up a buffer of data. When given data+known to be strict, use of BufferBuilder compiles directly into a series+of efficient C function calls.+-}+module Data.BufferBuilder (++ -- * The BufferBuilder Monad+ BufferBuilder , runBufferBuilder++ -- * Appending bytes and byte strings , appendByte , appendChar8 , appendBS+ , appendLBS+ , appendLiteral+ , unsafeAppendLiteralN++ -- * Appending bytes and byte strings, truncated to 7 bits+ , appendByte7+ , appendChar7+ , appendBS7+ , appendLiteral7+ , unsafeAppendLiteralN7++ -- * UTF-8 encoding+ , appendCharUtf8+ , appendStringUtf8++ -- * Printing numbers+ , appendDecimalSignedInt+ , appendDecimalDouble++ -- * JSON escaping+ , appendEscapedJson+ , appendEscapedJsonLiteral+ , appendEscapedJsonText ) where import GHC.Base@@ -17,34 +49,62 @@ import Foreign.Marshal.Alloc import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Lazy as BSL import Control.Monad.Reader+import Control.Applicative (Applicative) -data BWHandle'-type BWHandle = Ptr BWHandle'+import Data.Text () -- Show+import Data.Text.Internal (Text (..))+import Data.Text.Array (Array (..)) -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)+data Handle'+type Handle = Ptr Handle' --- | BufferBuilder sequences actions that append to an implicit,+foreign import ccall unsafe "strlen" c_strlen :: Ptr Word8 -> IO Int+foreign import ccall unsafe "bw_new" bw_new :: Int -> IO Handle+foreign import ccall unsafe "&bw_free" bw_free :: FunPtr (Handle -> IO ())+foreign import ccall unsafe "bw_get_size" bw_get_size :: Handle -> IO Int+foreign import ccall unsafe "bw_trim_and_release_address" bw_trim_and_release_address :: Handle -> IO (Ptr Word8)++foreign import ccall unsafe "bw_append_byte" bw_append_byte :: Handle -> Word8 -> IO ()+foreign import ccall unsafe "bw_append_char_utf8" bw_append_char_utf8 :: Handle -> Char -> IO ()+foreign import ccall unsafe "bw_append_bs" bw_append_bs :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_bsz" bw_append_bsz :: Handle -> Ptr Word8 -> IO ()++foreign import ccall unsafe "bw_append_byte7" bw_append_byte7 :: Handle -> Word8 -> IO ()+foreign import ccall unsafe "bw_append_bs7" bw_append_bs7 :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_bsz7" bw_append_bsz7 :: Handle -> Ptr Word8 -> IO ()++foreign import ccall unsafe "bw_append_decimal_signed_int" bw_append_decimal_signed_int :: Handle -> Int -> IO ()+foreign import ccall unsafe "bw_append_decimal_double" bw_append_decimal_double :: Handle -> Double -> IO ()++foreign import ccall unsafe "bw_append_json_escaped" bw_append_json_escaped :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_json_escaped_utf16" bw_append_json_escaped_utf16 :: Handle -> Int -> Ptr Word16 -> IO ()++-- | BufferBuilder is the type of a monadic action that appends 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)+-- buffer as a 'BS.ByteString'. +newtype BufferBuilder a = BB (ReaderT Handle IO a)+ deriving (Functor, Applicative, Monad, MonadReader Handle) inBW :: IO a -> BufferBuilder a inBW = BB . lift+{-# INLINE inBW #-} +withHandle :: (Handle -> IO ()) -> BufferBuilder ()+withHandle action = do+ h <- ask+ inBW $ action h+{-# INLINE withHandle #-}+ initialCapacity :: Int-initialCapacity = 48+initialCapacity = 20480 -- 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'+-- | Run a sequence of 'BufferBuilder' actions and extract the resulting+-- buffer as a 'BS.ByteString'. runBufferBuilder :: BufferBuilder () -> BS.ByteString runBufferBuilder = unsafeDupablePerformIO . runBufferBuilderIO initialCapacity @@ -61,12 +121,10 @@ touchForeignPtr handleFP return bs --appendByte :: Word8 -- ^ byte to append to the buffer.- -> BufferBuilder ()-appendByte b = do- h <- ask- inBW $ bw_append_byte h b+-- | Append a single byte to the output buffer. To append multiple bytes in sequence and+-- avoid redundant bounds checks, consider using 'appendBS', 'appendLiteral', or 'unsafeAppendLiteralN'.+appendByte :: Word8 -> BufferBuilder ()+appendByte b = withHandle $ \h -> bw_append_byte h b {-# INLINE appendByte #-} c2w :: Char -> Word8@@ -74,16 +132,136 @@ {-# 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 :: Char -> 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)+-- | Appends a 'BS.ByteString' to the buffer. When appending constant, hardcoded strings, to+-- avoid a CAF and the costs of its associated tag check and indirect jump, use+-- 'appendLiteral' or 'unsafeAppendLiteralN' instead.+appendBS :: BS.ByteString -> BufferBuilder ()+appendBS !(BS.PS fp offset len) =+ withHandle $ \h ->+ withForeignPtr fp $ \addr ->+ bw_append_bs h len (plusPtr addr offset) {-# INLINE appendBS #-} +-- | Appends a lazy 'BSL.ByteString' to the buffer. This function operates by traversing+-- the lazy 'BSL.ByteString' chunks, appending each in turn.+appendLBS :: BSL.ByteString -> BufferBuilder ()+appendLBS lbs = mapM_ appendBS $ BSL.toChunks lbs+{-# INLINABLE appendLBS #-}++-- | Appends a zero-terminated MagicHash string literal. Use this function instead of+-- 'appendBS' for string constants. For example:+--+-- > appendLiteral "true"#+--+-- If the length of the string literal is known, calling+-- 'unsafeAppendLiteralN' is faster, as 'unsafeAppendLiteralN' avoids a strlen+-- operation which has nontrivial cost in some benchmarks.+appendLiteral :: Addr# -> BufferBuilder ()+appendLiteral addr =+ withHandle $ \h ->+ bw_append_bsz h (Ptr addr)+{-# INLINE appendLiteral #-}++-- | Appends a MagicHash string literal with a known length. Use this when the+-- string literal's length is known. For example:+--+-- > unsafeAppendLiteralN 4 "true"#+--+-- Per byte, this is the fastest append function. It amounts to a C function call+-- with two constant arguments. The C function checks to see if it needs to grow+-- the buffer and then it simply calls memcpy.+-- +-- __WARNING__: passing an incorrect length value is likely to cause an access+-- violation or worse.+unsafeAppendLiteralN :: Int -> Addr# -> BufferBuilder ()+unsafeAppendLiteralN len addr =+ withHandle $ \h ->+ bw_append_bs h len (Ptr addr)+{-# INLINE unsafeAppendLiteralN #-}+++-- 7-bit truncation++appendByte7 :: Word8 -> BufferBuilder ()+appendByte7 b = withHandle $ \h -> bw_append_byte7 h b+{-# INLINE appendByte7 #-}++appendChar7 :: Char -> BufferBuilder ()+appendChar7 = appendByte7 . c2w+{-# INLINE appendChar7 #-}++appendBS7 :: BS.ByteString -> BufferBuilder ()+appendBS7 !(BS.PS fp offset len) =+ withHandle $ \h ->+ withForeignPtr fp $ \addr ->+ bw_append_bs7 h len (plusPtr addr offset)+{-# INLINE appendBS7 #-}++appendLiteral7 :: Addr# -> BufferBuilder ()+appendLiteral7 addr =+ withHandle $ \h ->+ bw_append_bsz7 h (Ptr addr)+{-# INLINE appendLiteral7 #-}++unsafeAppendLiteralN7 :: Int -> Addr# -> BufferBuilder ()+unsafeAppendLiteralN7 len addr =+ withHandle $ \h ->+ bw_append_bs7 h len (Ptr addr)+{-# INLINE unsafeAppendLiteralN7 #-}++-- Encoding UTF-8++-- | Appends a UTF-8-encoded 'Char' to the buffer.+appendCharUtf8 :: Char -> BufferBuilder ()+appendCharUtf8 c = withHandle $ \h -> bw_append_char_utf8 h c+{-# INLINE appendCharUtf8 #-}++-- | Appends a UTF-8-encoded 'String' to the buffer. The best way to improve performance here+-- is to use 'BS.ByteString' or 'Text' instead of 'String'.+appendStringUtf8 :: String -> BufferBuilder ()+appendStringUtf8 = mapM_ appendCharUtf8+{-# INLINABLE appendStringUtf8 #-}+++-- Printing Numbers++-- | Appends a decimal integer, just like calling printf("%d", ...)+appendDecimalSignedInt :: Int -> BufferBuilder ()+appendDecimalSignedInt i =+ withHandle $ \h ->+ bw_append_decimal_signed_int h i+{-# INLINE appendDecimalSignedInt #-}++-- | Appends a decimal double, just like calling printf("%f", ...)+appendDecimalDouble :: Double -> BufferBuilder ()+appendDecimalDouble d =+ withHandle $ \h ->+ bw_append_decimal_double h d+{-# INLINE appendDecimalDouble #-}+++-- Encoding JSON++appendEscapedJson :: BS.ByteString -> BufferBuilder ()+appendEscapedJson !(BS.PS (ForeignPtr addr _) offset len) =+ withHandle $ \h ->+ bw_append_json_escaped h len (plusPtr (Ptr addr) offset)+{-# INLINE appendEscapedJson #-}++appendEscapedJsonLiteral :: Addr# -> BufferBuilder ()+appendEscapedJsonLiteral addr =+ withHandle $ \h -> do+ len <- c_strlen (Ptr addr)+ bw_append_json_escaped h len (Ptr addr)+{-# INLINE appendEscapedJsonLiteral #-}++appendEscapedJsonText :: Text -> BufferBuilder ()+appendEscapedJsonText !(Text arr ofs len) =+ let byteArray = aBA arr+ in withHandle $ \h ->+ bw_append_json_escaped_utf16 h len (Ptr (byteArrayContents# byteArray) `plusPtr` ofs)+{-# INLINE appendEscapedJsonText #-}
+ Data/BufferBuilder/Json.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, UndecidableInstances #-}++{-|+A library for efficiently building up a valid JSON document.++The difference between "Data.BufferBuilder.Json" and the excellent+"Data.Aeson" is that Aeson represents the JSON document as an+in-memory tree structure before encoding it into bytes. This module,+on the other hand, represents each value as an action that writes its+representation directly into the output buffer. At the cost of+reduced flexibility, this results in significantly improved encoding+performance. At the time of this writing, encoding a custom record+type into JSON using this module was almost 5x faster than using+Aeson.++This module is built on top of "Data.Utf8Builder".+-}+module Data.BufferBuilder.Json+ (+ -- * Encoding Values+ Value+ , ToJson (..)+ , encodeJson++ -- * Objects+ , ObjectBuilder+ , emptyObject+ , (.=)+ , (.=#)++ -- * Arrays+ , array++ -- * Null+ , nullValue++ -- * Unsafe+ , unsafeAppendBS+ , unsafeAppendUtf8Builder+ ) where++import GHC.Base+import Foreign.Storable+import Control.Monad (when, forM_)+import Data.BufferBuilder.Utf8 (Utf8Builder)+import qualified Data.BufferBuilder.Utf8 as UB+import Data.ByteString (ByteString)+import Data.Monoid+import Data.Text (Text)+import Data.Foldable (Foldable, foldMap)+import qualified Data.Vector as Vector+import qualified Data.Vector.Generic as GVector+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.HashMap.Strict as HashMap++-- | Represents a JSON value.+--+-- 'Value's are built up from either 'ToJson' instances or+-- from primitives like 'emptyObject', 'array', and 'null'.+--+-- In special cases, or when performance is of utmost importance, the+-- unsafe functions 'unsafeAppendBS' and 'unsafeAppendUtf8Builder' are+-- available.+--+-- Internally, Value encodes an action or sequence of actions that append+-- JSON-encoded text to the underlying 'Utf8Builder'.+newtype Value = Value { utf8Builder :: Utf8Builder () }++-- | The class of types that can be converted to JSON values. See+-- 'ObjectBuilder' for an example of writing a 'ToJson' instance for a+-- custom data type.+--+-- 'ToJson' instances are provided for many common types. For+-- example, to create a JSON array, call 'toJson' on a list or 'Vector.Vector'.+-- To create a JSON object, call 'toJson' on a 'HashMap.HashMap'.+class ToJson a where+ toJson :: a -> Value++---- General JSON value support++-- | Encode a value into a 'ByteString' containing valid UTF-8-encoded JSON.+-- The argument value must have a corresponding 'ToJson' instance.+--+-- __WARNING__: There are three cases where the resulting 'ByteString' may not contain+-- legal JSON:+--+-- * An unsafe function was used to encode a JSON value.+-- * The root value is not an object or array, as the JSON specification requires.+-- * An object has multiple keys with the same value. For maximum efficiency,+-- 'ObjectBuilder' does not check key names for uniqueness, so it's possible to+-- construct objects with duplicate keys.+encodeJson :: ToJson a => a -> ByteString+encodeJson = UB.runUtf8Builder . utf8Builder . toJson+{-# INLINE encodeJson #-}++---- Objects++-- | Builds a JSON object.+--+-- An 'ObjectBuilder' builds one or more key-value pairs of a JSON object. They are constructed with the '.=' operator and+-- combined with 'Data.Monoid.<>'.+--+-- To turn an 'ObjectBuilder' into a 'Value', use its 'ToJson' class instance.+--+-- @+-- data Friend = Friend+-- { fId :: !Int+-- , fName :: !Text+-- } deriving (Eq, Show)+--+-- instance ToJson Friend where+-- toJson friend = toJson $+-- "id" .= fId friend+-- <> "name" .= fName friend+-- @+--+-- __WARNING__: 'ObjectBuilder' does not check uniqueness of object+-- keys. If two keys with the same value are inserted, then the+-- resulting JSON document will be illegal.+data ObjectBuilder = NoPair | Pair !(Utf8Builder ())++instance Monoid ObjectBuilder where+ {-# INLINE mempty #-}+ mempty = NoPair++ {-# INLINE mappend #-}+ mappend NoPair a = a+ mappend a NoPair = a+ mappend (Pair a) (Pair b) = Pair $ do + a+ UB.appendChar7 ','+ b++instance ToJson ObjectBuilder where+ {-# INLINE toJson #-}+ toJson NoPair = Value $ do+ UB.appendChar7 '{'+ UB.appendChar7 '}'++ toJson (Pair a) = Value $ do+ UB.appendChar7 '{'+ a+ UB.appendChar7 '}'++-- | A 'Value' that produces the empty object.+emptyObject :: Value+emptyObject = toJson NoPair+{-# INLINE emptyObject #-}++-- | Create an 'ObjectBuilder' from a key and a value.+(.=) :: ToJson a => Text -> a -> ObjectBuilder+a .= b = Pair $ do+ UB.appendEscapedJsonText a+ UB.appendChar7 ':'+ utf8Builder $ toJson b+infixr 8 .=+{-# INLINE (.=) #-}++-- | Create an 'ObjectBuilder' from a key and a value. The key is an+-- ASCII-7, unescaped, zero-terminated 'Addr#'.+--+-- __WARNING__: This function is unsafe. If the key is NOT+-- zero-terminated, then an access violation might result. If the key+-- is not a sequence of unescaped ASCII characters, the resulting JSON+-- document will be illegal.+--+-- This function is provided for maximum performance in the common+-- case that object keys are ASCII-7. It achieves performance by+-- avoiding the CAF for a Text literal and avoiding the need to+-- transcode UTF-16 to UTF-8 and escape.+--+-- To use this function, the calling source file must have the+-- MagicHash extension enabled.+--+-- @+-- data Friend = Friend+-- { fId :: !Int+-- , fName :: !Text+-- } deriving (Eq, Show)+--+-- instance ToJson Friend where+-- toJson friend = toJson $+-- "id"\# .=\# fId friend+-- <> "name"\# .=\# fName friend+-- @+(.=#) :: ToJson a => Addr# -> a -> ObjectBuilder+a .=# b = Pair $ do+ UB.appendEscapedJsonLiteral a+ UB.appendChar7 ':'+ utf8Builder $ toJson b+infixr 8 .=#+{-# INLINE (.=#) #-}+++{-# INLINE writePair #-}+writePair :: ToJson a => (Text, a) -> Utf8Builder ()+writePair (key, value) = do+ UB.appendEscapedJsonText key+ UB.appendChar7 ':'+ utf8Builder $ toJson value++instance ToJson a => ToJson (HashMap.HashMap Text a) where+ {-# INLINABLE toJson #-}+ toJson hm = Value $ do+ UB.appendChar7 '{'+ case HashMap.toList hm of+ [] -> UB.appendChar7 '}'+ (x:xs) -> do+ writePair x+ forM_ xs $ \p -> do+ UB.appendChar7 ','+ writePair p+ UB.appendChar7 '}'++---- Arrays++-- | Serialize any 'Foldable' as a JSON array. This is generally+-- slower than directly calling 'toJson' on a list or 'Vector.Vector',+-- but it will convert any 'Foldable' type into an array.+array :: (Foldable t, ToJson a) => t a -> Value+array collection = Value $ do+ UB.appendChar7 '['+ -- HACK: ObjectBuilder is not "type correct" but it has exactly the behaviour we want for this function.+ case foldMap (Pair . utf8Builder . toJson) collection of+ NoPair -> return ()+ (Pair b) -> b+ UB.appendChar7 ']'+{-# INLINABLE array #-}++instance ToJson a => ToJson [a] where+ {-# INLINABLE toJson #-}+ toJson !ls = Value $ do+ UB.appendChar7 '['+ case ls of+ [] -> UB.appendChar7 ']'+ x:xs -> do+ utf8Builder $ toJson x+ forM_ xs $ \(!e) -> do+ UB.appendChar7 ','+ utf8Builder $ toJson e+ UB.appendChar7 ']'++instance ToJson a => ToJson (Vector.Vector a) where+ {-# INLINABLE toJson #-}+ toJson = vector++instance (Storable a, ToJson a) => ToJson (VS.Vector a) where+ {-# INLINABLE toJson #-}+ toJson = vector++instance (VP.Prim a, ToJson a) => ToJson (VP.Vector a) where+ {-# INLINABLE toJson #-}+ toJson = vector++instance (GVector.Vector VU.Vector a, ToJson a) => ToJson (VU.Vector a) where+ {-# INLINABLE toJson #-}+ toJson = vector++{-# INLINABLE vector #-}+vector :: (GVector.Vector v a, ToJson a) => v a -> Value+vector !vec = Value $ do+ UB.appendChar7 '['+ let len = GVector.length vec+ when (len /= 0) $ do+ utf8Builder $ toJson (vec `GVector.unsafeIndex` 0)+ GVector.forM_ (GVector.tail vec) $ \e -> do+ UB.appendChar7 ','+ utf8Builder $ toJson e+ UB.appendChar7 ']'+++----++-- | Represents a JSON "null".+nullValue :: Value+nullValue = Value $ UB.unsafeAppendLiteralN 4 "null"#+{-# INLINE nullValue #-}++---- Common JSON instances++instance ToJson Value where+ {-# INLINE toJson #-}+ toJson = id++instance ToJson Bool where+ {-# INLINE toJson #-}+ toJson True = Value $ UB.unsafeAppendLiteralN 4 "true"#+ toJson False = Value $ UB.unsafeAppendLiteralN 5 "false"#++instance ToJson a => ToJson (Maybe a) where+ {-# INLINE toJson #-}+ toJson m = case m of+ Nothing -> Value $ UB.unsafeAppendLiteralN 4 "null"#+ Just a -> toJson a++instance ToJson Text where+ {-# INLINE toJson #-}+ toJson txt = Value $ UB.appendEscapedJsonText txt++instance ToJson Double where+ {-# INLINE toJson #-}+ toJson a = Value $ UB.appendDecimalDouble a++instance ToJson Int where+ {-# INLINE toJson #-}+ toJson a = Value $ UB.appendDecimalSignedInt a+++---- Unsafe functions++-- | Unsafely append a string into a JSON document.+-- This function does /not/ escape, quote, or otherwise decorate the string in any way.+-- This function is /unsafe/ because you can trivially use it to generate illegal JSON.+unsafeAppendBS :: ByteString -> Value+unsafeAppendBS bs = Value $ UB.unsafeAppendBS bs++-- | Unsafely append a 'Utf8Builder' into a JSON document.+-- This function does not escape, quote, or decorate the string in any way.+-- This function is /unsafe/ because you can trivially use it to generate illegal JSON.+unsafeAppendUtf8Builder :: Utf8Builder () -> Value+unsafeAppendUtf8Builder utf8b = Value utf8b
+ Data/BufferBuilder/Utf8.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MagicHash, BangPatterns #-}++{-|+A library for efficiently building up a buffer of UTF-8-encoded text. If only+safe functions are used, the resulting 'ByteString' is guaranteed to be valid+UTF-8.++To run a sequence of Utf8Builder actions and retrieve the resulting buffer, use+'runUtf8Builder'.++In special situations, for maximum performance, unsafe functions are+also provided. The unsafe functions do not guarantee the buffer is+correct UTF-8.++This module is built on top of "Data.BufferBuilder".+-}+module Data.BufferBuilder.Utf8 (++ -- * The Utf8Builder Monad+ Utf8Builder+ , runUtf8Builder++ -- * Text encoding+ , appendText+ , appendString+ , appendChar++ -- * ASCII-7+ , appendByte7+ , appendChar7+ , appendBS7+ , appendLiteral7++ -- * Printing numbers+ , appendDecimalSignedInt+ , appendDecimalDouble++ -- * Escaped JSON+ , appendEscapedJson+ , appendEscapedJsonLiteral+ , appendEscapedJsonText++ -- * Unsafe append operations+ , unsafeAppendByte+ , unsafeAppendChar8+ , unsafeAppendLiteral+ , unsafeAppendLiteralN+ , unsafeAppendBS+ ) where++import GHC.Base+import GHC.Word+import Control.Applicative+import Data.ByteString (ByteString)+import Data.BufferBuilder (BufferBuilder)+import qualified Data.BufferBuilder as BB+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)++newtype Utf8Builder a = Utf8Builder { unBuilder :: BufferBuilder a }+ deriving (Functor, Applicative, Monad)++-- | Run a sequence of 'Utf8Builder' actions and extracting the resulting+-- buffer as a 'ByteString'.+runUtf8Builder :: Utf8Builder () -> ByteString+runUtf8Builder a = BB.runBufferBuilder $ unBuilder a+{-# INLINE runUtf8Builder #-}+++-- Text encoding++-- TODO: optimize appendText with custom UTF-16 -> UTF-8 encoder in C++-- | Encodes the given 'Text' in UTF-8, appending it to the buffer.+appendText :: Text -> Utf8Builder ()+appendText a = Utf8Builder $ BB.appendBS $ encodeUtf8 a+{-# INLINE appendText #-}++-- | Encodes the given 'String' in UTF-8, appending it to the buffer.+appendString :: String -> Utf8Builder ()+appendString s = mapM_ appendChar s+{-# INLINABLE appendString #-}++-- | Encodes a single 'Char' in UTF-8, appending it to the buffer.+appendChar :: Char -> Utf8Builder ()+appendChar c = Utf8Builder $ BB.appendCharUtf8 c+{-# INLINE appendChar #-}+++-- ASCII-7++-- | Appends the bottom 7 bits of a byte to the buffer.+appendByte7 :: Word8 -> Utf8Builder ()+appendByte7 = Utf8Builder . BB.appendByte7+{-# INLINE appendByte7 #-}++-- | Appends the bottom 7 bits of a 'Char' to the buffer.+appendChar7 :: Char -> Utf8Builder ()+appendChar7 = Utf8Builder . BB.appendChar7+{-# INLINE appendChar7 #-}++-- | Appends the given ByteString to the buffer, taking the bottom+-- 7 bits of each byte.+appendBS7 :: ByteString -> Utf8Builder ()+appendBS7 = Utf8Builder . BB.appendBS7+{-# INLINE appendBS7 #-}++-- | Appends the zero-terminated byte string at the given address+-- to the buffer, taking the bottom 7 bits of each byte.+appendLiteral7 :: Addr# -> Utf8Builder ()+appendLiteral7 addr = Utf8Builder $ BB.appendLiteral7 addr+{-# INLINE appendLiteral7 #-}+++-- Printing numbers++appendDecimalSignedInt :: Int -> Utf8Builder ()+appendDecimalSignedInt a = Utf8Builder $ BB.appendDecimalSignedInt a+{-# INLINE appendDecimalSignedInt #-}++appendDecimalDouble :: Double -> Utf8Builder ()+appendDecimalDouble d = Utf8Builder $ BB.appendDecimalDouble d+{-# INLINE appendDecimalDouble #-}+++-- Escaped JSON++appendEscapedJsonLiteral :: Addr# -> Utf8Builder ()+appendEscapedJsonLiteral addr = Utf8Builder $ BB.appendEscapedJsonLiteral addr++appendEscapedJson :: ByteString -> Utf8Builder ()+appendEscapedJson a = Utf8Builder $ BB.appendEscapedJson a+{-# INLINE appendEscapedJson #-}++appendEscapedJsonText :: Text -> Utf8Builder ()+appendEscapedJsonText txt = Utf8Builder $ BB.appendEscapedJsonText txt+{-# INLINE appendEscapedJsonText #-}+++-- Unsafe++-- | Directly append a byte into the UTF-8 code stream. Incorrect use of+-- this function can result in invalid UTF-8.+unsafeAppendByte :: Word8 -> Utf8Builder ()+unsafeAppendByte = Utf8Builder . BB.appendByte+{-# INLINE unsafeAppendByte #-}++-- | Directly append the bottom 8 bits of the given character to the UTF-8+-- code stream. Incorrect use of this function can result in invalid UTF-8.+unsafeAppendChar8 :: Char -> Utf8Builder ()+unsafeAppendChar8 = Utf8Builder . BB.appendChar8+{-# INLINE unsafeAppendChar8 #-}++-- | Directly append the zero-terminated byte sequence pointed to by+-- the given address. Be careful that the referenced byte sequence+-- contains valid UTF-8.+unsafeAppendLiteral :: Addr# -> Utf8Builder ()+unsafeAppendLiteral addr = Utf8Builder $ BB.appendLiteral addr+{-# INLINE unsafeAppendLiteral #-}++-- | Directly append the given byte sequence pointed to by the given address.+-- Be careful that the referenced byte sequence contains valid UTF-8.+--+-- __WARNING__: passing an incorrect length value is likely to cause an access+-- violation or worse.+unsafeAppendLiteralN :: Int -> Addr# -> Utf8Builder ()+unsafeAppendLiteralN !len addr = Utf8Builder $ BB.unsafeAppendLiteralN len addr+{-# INLINE unsafeAppendLiteralN #-}++-- | Directly append the given 'ByteString' to the output buffer.+-- Be careful that the referenced 'ByteString' contains valid UTF-8.+unsafeAppendBS :: ByteString -> Utf8Builder ()+unsafeAppendBS a = Utf8Builder $ BB.appendBS a+{-# INLINE unsafeAppendBS #-}
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, IMVU, Chad Austin+Copyright (c) 2015, IMVU, Chad Austin, Andy Friesen All rights reserved.
bench/Bench.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, BangPatterns, RecordWildCards #-}+{-# LANGUAGE OverloadedStrings, BangPatterns, RecordWildCards, MagicHash #-} import Data.ByteString (ByteString) import Criterion.Main@@ -39,6 +39,26 @@ appendChar8 '#' appendBS "hashyhashyhashy" +buildURLLiterals :: Int -> ByteString+buildURLLiterals times = runBufferBuilder $ do+ replicateM_ times $ do+ -- literals avoid the CAFs for ByteString constants+ unsafeAppendLiteralN 4 "http"#+ unsafeAppendLiteralN 3 "://"#+ unsafeAppendLiteralN 11 "example.com"#+ appendChar8 '/'+ unsafeAppendLiteralN 18 "the/path/goes/here"#+ appendChar8 '?'+ unsafeAppendLiteralN 3 "key"#+ appendChar8 '='+ unsafeAppendLiteralN 5 "value"#+ appendChar8 '?'+ unsafeAppendLiteralN 8 "otherkey"#+ appendChar8 '='+ unsafeAppendLiteralN 10 "othervalue"#+ appendChar8 '#'+ unsafeAppendLiteralN 15 "hashyhashyhashy"#+ data Record = Record { f1 :: !ByteString , f2 :: !ByteString@@ -74,4 +94,5 @@ main :: IO () main = defaultMain [ bench "buildURL" $ nf buildURL 10+ , bench "buildURLLiterals" $ nf buildURLLiterals 10 , bench "encodeRecord" $ nf encodeType recordValue ]
+ bench/JsonBench.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}++module Main (main) where++import Criterion++import Criterion.Main++import Data.Monoid ((<>))++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++import qualified Data.BufferBuilder.Json as Json+import Data.Text (Text)+import qualified Data.Aeson as Aeson+import Data.Aeson ((.:))+import qualified Data.Vector as Vector+import Control.DeepSeq (NFData (..), force)+import qualified Data.Vector.Unboxed as UnboxedVector++data EyeColor = Green | Blue | Brown+ deriving (Eq, Show)+data Gender = Male | Female+ deriving (Eq, Show)+data Fruit = Apple | Strawberry | Banana+ deriving (Eq, Show)+data Friend = Friend+ { fId :: !Int+ , fName :: !Text+ } deriving (Eq, Show)++data User = User+ { uId :: !Text+ , uIndex :: !Int+ , uGuid :: !Text+ , uIsActive :: !Bool+ , uBalance :: !Text+ , uPicture :: !Text+ , uAge :: !Int+ , uEyeColor :: !EyeColor+ , uName :: !Text+ , uGender :: !Gender+ , uCompany :: !Text+ , uEmail :: !Text+ , uPhone :: !Text+ , uAddress :: !Text+ , uAbout :: !Text+ , uRegistered :: !Text -- UTCTime?+ , uLatitude :: !Double+ , uLongitude :: !Double+ , uTags :: ![Text]+ , uFriends :: ![Friend]+ , uGreeting :: !Text+ , uFavouriteFruit :: !Fruit+ } deriving (Eq, Show)++instance NFData EyeColor+instance NFData Gender+instance NFData Fruit++instance NFData Friend where+ rnf Friend {..} = (rnf fId) `seq` (rnf fName) `seq` ()++instance NFData User where+ rnf User {..} = (rnf uId) `seq` (rnf uIndex) `seq` (rnf uGuid) `seq` (rnf uIsActive) `seq` (rnf uBalance) `seq` (rnf uPicture) `seq` (rnf uAge) `seq` (rnf uEyeColor) `seq` (rnf uName) `seq` (rnf uGender) `seq` (rnf uCompany) `seq` (rnf uEmail) `seq` (rnf uPhone) `seq` (rnf uAddress) `seq` (rnf uAbout) `seq` (rnf uRegistered) `seq` (rnf uLatitude) `seq` (rnf uLongitude) `seq` (rnf uTags) `seq` (rnf uFriends) `seq` (rnf uGreeting) `seq` (rnf uFavouriteFruit) `seq` ()++eyeColorTable :: [(Text, EyeColor)]+eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]++genderTable :: [(Text, Gender)]+genderTable = [("male", Male), ("female", Female)]++fruitTable :: [(Text, Fruit)]+fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]++enumFromJson :: Monad m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum+enumFromJson enumName table extract v = do+ s <- extract v+ case lookup s table of+ Just r -> return r+ Nothing -> fail $ "Bad " ++ enumName ++ ": " ++ show s++--- Aeson instances ---++instance Aeson.FromJSON EyeColor where+ parseJSON = enumFromJson "EyeColor" eyeColorTable Aeson.parseJSON++instance Aeson.FromJSON Gender where+ parseJSON = enumFromJson "Gender" genderTable Aeson.parseJSON++instance Aeson.FromJSON Fruit where+ parseJSON = enumFromJson "Fruit" fruitTable Aeson.parseJSON++instance Aeson.FromJSON Friend where+ parseJSON = Aeson.withObject "Friend" $ \o -> do+ fId <- o .: "id"+ fName <- o .: "name"+ return Friend {..}++instance Aeson.FromJSON User where+ parseJSON = Aeson.withObject "User" $ \o -> do+ uId <- o .: "_id"+ uIndex <- o .: "index"+ uGuid <- o .: "guid"+ uIsActive <- o .: "isActive"+ uBalance <- o .: "balance"+ uPicture <- o .: "picture"+ uAge <- o .: "age"+ uEyeColor <- o .: "eyeColor"+ uName <- o .: "name"+ uGender <- o .: "gender"+ uCompany <- o .: "company"+ uEmail <- o .: "email"+ uPhone <- o .: "phone"+ uAddress <- o .: "address"+ uAbout <- o .: "about"+ uRegistered <- o .: "registered"+ uLatitude <- o .: "latitude"+ uLongitude <- o .: "longitude"+ uTags <- o .: "tags"+ uFriends <- o .: "friends"+ uGreeting <- o .: "greeting"+ uFavouriteFruit <- o .: "favoriteFruit"+ return User {..}++instance Aeson.ToJSON EyeColor where+ toJSON ec = Aeson.toJSON $ case ec of+ Green -> "green" :: Text+ Blue -> "blue"+ Brown -> "brown"++instance Aeson.ToJSON Gender where+ toJSON g = Aeson.toJSON $ case g of+ Male -> "male" :: Text+ Female -> "female"++instance Aeson.ToJSON Fruit where+ toJSON f = Aeson.toJSON $ case f of+ Apple -> "apple" :: Text+ Banana -> "banana"+ Strawberry -> "strawberry"++instance Aeson.ToJSON Friend where+ toJSON Friend {..} = Aeson.object+ [ "id" Aeson..= fId+ , "name" Aeson..= fName+ ]++instance Aeson.ToJSON User where+ toJSON User{..} = Aeson.object+ [ "_id" Aeson..= uId+ , "index" Aeson..= uIndex+ , "guid" Aeson..= uGuid+ , "isActive" Aeson..= uIsActive+ , "balance" Aeson..= uBalance+ , "picture" Aeson..= uPicture+ , "age" Aeson..= uAge+ , "eyeColor" Aeson..= uEyeColor+ , "name" Aeson..= uName+ , "gender" Aeson..= uGender+ , "company" Aeson..= uCompany+ , "email" Aeson..= uEmail+ , "phone" Aeson..= uPhone+ , "address" Aeson..= uAddress+ , "about" Aeson..= uAbout+ , "registered" Aeson..= uRegistered+ , "latitude" Aeson..= uLatitude+ , "longitude" Aeson..= uLongitude+ , "tags" Aeson..= uTags+ , "friends" Aeson..= uFriends+ , "greeting" Aeson..= uGreeting+ , "favoriteFruit" Aeson..= uFavouriteFruit+ ]++--- BufferBuilder instances ---++instance Json.ToJson EyeColor where+ toJson ec = Json.toJson $ case ec of+ Green -> "green" :: Text+ Blue -> "blue"+ Brown -> "brown"++instance Json.ToJson Gender where+ toJson g = Json.toJson $ case g of+ Male -> "male" :: Text+ Female -> "female"++instance Json.ToJson Fruit where+ toJson f = Json.toJson $ case f of+ Apple -> "apple" :: Text+ Strawberry -> "strawberry"+ Banana -> "banana"++instance Json.ToJson Friend where+ toJson Friend{..} = Json.toJson $+ "_id" Json..= fId+ <> "name" Json..= fName++instance Json.ToJson User where+ toJson User{..} = Json.toJson $+ "_id"# Json..=# uId+ <> "index"# Json..=# uIndex+ <> "guid"# Json..=# uGuid+ <> "isActive"# Json..=# uIsActive+ <> "balance"# Json..=# uBalance+ <> "picture"# Json..=# uPicture+ <> "age"# Json..=# uAge+ <> "eyeColor"# Json..=# uEyeColor+ <> "name"# Json..=# uName+ <> "gender"# Json..=# uGender+ <> "company"# Json..=# uCompany+ <> "email"# Json..=# uEmail+ <> "phone"# Json..=# uPhone+ <> "address"# Json..=# uAddress+ <> "about"# Json..=# uAbout+ <> "registered"# Json..=# uRegistered+ <> "latitude"# Json..=# uLatitude+ <> "longitude"# Json..=# uLongitude+ <> "tags"# Json..=# uTags+ <> "friends"# Json..=# uFriends+ <> "greeting"# Json..=# uGreeting+ <> "favoriteFruit"# Json..=# uFavouriteFruit++encodeUserNaively :: User -> Json.Value+encodeUserNaively User{..} =+ Json.toJson $+ "_id" Json..= uId+ <> "index" Json..= uIndex+ <> "guid" Json..= uGuid+ <> "isActive" Json..= uIsActive+ <> "balance" Json..= uBalance+ <> "picture" Json..= uPicture+ <> "age" Json..= uAge+ <> "eyeColor" Json..= uEyeColor+ <> "name" Json..= uName+ <> "gender" Json..= uGender+ <> "company" Json..= uCompany+ <> "email" Json..= uEmail+ <> "phone" Json..= uPhone+ <> "address" Json..= uAddress+ <> "about" Json..= uAbout+ <> "registered" Json..= uRegistered+ <> "latitude" Json..= uLatitude+ <> "longitude" Json..= uLongitude+ <> "tags" Json..= uTags+ <> "friends" Json..= uFriends+ <> "greeting" Json..= uGreeting+ <> "favoriteFruit" Json..= uFavouriteFruit+--- ---++main :: IO ()+main = do+ content <- BS.readFile "test.json"+ let lazyContent = force $ BSL.fromChunks [content]++ let parsedUserList :: [User]+ Just parsedUserList = Aeson.decode lazyContent++ defaultMain [ bgroup "vector"+ [ bench "vector bool" $ nf Json.encodeJson (Vector.replicate 100000 True)+ , bench "vector int" $ nf Json.encodeJson (Vector.replicate 100000 (1234 :: Int))+ , bench "vector text" $ nf Json.encodeJson (Vector.replicate 100000 ("hello world" :: Text))+ ]+ , bgroup "list-foldable"+ [ bench "list-foldable bool" $ nf (Json.encodeJson . Json.array) (replicate 100000 True)+ , bench "list-foldable int" $ nf (Json.encodeJson . Json.array) (replicate 100000 (1234 :: Int))+ , bench "list-foldable text" $ nf (Json.encodeJson . Json.array) (replicate 100000 ("hello world" :: Text))+ ]+ , bgroup "list"+ [ bench "list bool" $ nf Json.encodeJson (replicate 100000 True)+ , bench "list int" $ nf Json.encodeJson (replicate 100000 (1234 :: Int))+ , bench "list text" $ nf Json.encodeJson (replicate 100000 ("hello world" :: Text))+ ]+ , bgroup "render"+ [ bench "bufferbuilder" $ nf Json.encodeJson parsedUserList+ , bench "aeson" $ nf Aeson.encode parsedUserList+ ]+ , bgroup "addr vs text keys"+ [ bench "addr" $ nf Json.encodeJson parsedUserList+ , bench "text" $ nf Json.encodeJson $ fmap encodeUserNaively parsedUserList+ ]+ , bgroup "breakout"+ [ bench "Vector" $ nf Json.encodeJson (Vector.fromList $! [0..65535] :: Vector.Vector Int)+ , bench "Vector.Unboxed" $ nf Json.encodeJson (UnboxedVector.fromList $! [0..65535] :: UnboxedVector.Vector Int)+ ]+ ]
+ bench/TinyJson.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MagicHash #-}++module Main where++import Data.Text+import Data.BufferBuilder.Json+import qualified Data.ByteString.Char8 as BSC8++data TinyRecord = TR+ { name :: !Text+ , number :: !Int+ }++instance ToJson TinyRecord where+ toJson !TR{..} = toJson $+ "name" .= (9::Int)+ -- <> "number" .= number++a :: TinyRecord+a = TR "Bob" 9++main :: IO ()+main = do+ let !b = encodeJson a+ putStrLn $ BSC8.unpack b
+ bench/TinyJson2.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MagicHash #-}++module Main where++import Data.BufferBuilder.Json+import qualified Data.ByteString.Char8 as BSC8+import Data.Vector.Unboxed (Vector)+import qualified Data.Vector.Unboxed as Vector++main :: IO ()+main = do+ let !v = Vector.fromList [1, 2, 3, 4] :: Vector Int+ let !b = encodeJson v+ putStrLn $ BSC8.unpack b
+ branchlut.cpp view
@@ -0,0 +1,275 @@+/** <https://github.com/miloyip/itoa-benchmark/blob/940542a7770155ee3e9f2777ebc178dc899b43e0/src/branchlut.cpp>+ */++#include <string.h>+#include <stdint.h>++static const char gDigitsLut[200] = {+ '0','0','0','1','0','2','0','3','0','4','0','5','0','6','0','7','0','8','0','9',+ '1','0','1','1','1','2','1','3','1','4','1','5','1','6','1','7','1','8','1','9',+ '2','0','2','1','2','2','2','3','2','4','2','5','2','6','2','7','2','8','2','9',+ '3','0','3','1','3','2','3','3','3','4','3','5','3','6','3','7','3','8','3','9',+ '4','0','4','1','4','2','4','3','4','4','4','5','4','6','4','7','4','8','4','9',+ '5','0','5','1','5','2','5','3','5','4','5','5','5','6','5','7','5','8','5','9',+ '6','0','6','1','6','2','6','3','6','4','6','5','6','6','6','7','6','8','6','9',+ '7','0','7','1','7','2','7','3','7','4','7','5','7','6','7','7','7','8','7','9',+ '8','0','8','1','8','2','8','3','8','4','8','5','8','6','8','7','8','8','8','9',+ '9','0','9','1','9','2','9','3','9','4','9','5','9','6','9','7','9','8','9','9'+};++// Branching for different cases (forward)+// Use lookup table of two digits++size_t u32toa_branchlut(uint32_t value, char* buffer) {+ char* start = buffer;++ if (value < 10000) {+ const uint32_t d1 = (value / 100) << 1;+ const uint32_t d2 = (value % 100) << 1;+ + if (value >= 1000)+ *buffer++ = gDigitsLut[d1];+ if (value >= 100)+ *buffer++ = gDigitsLut[d1 + 1];+ if (value >= 10)+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ }+ else if (value < 100000000) {+ // value = bbbbcccc+ const uint32_t b = value / 10000;+ const uint32_t c = value % 10000;+ + const uint32_t d1 = (b / 100) << 1;+ const uint32_t d2 = (b % 100) << 1;+ + const uint32_t d3 = (c / 100) << 1;+ const uint32_t d4 = (c % 100) << 1;+ + if (value >= 10000000)+ *buffer++ = gDigitsLut[d1];+ if (value >= 1000000)+ *buffer++ = gDigitsLut[d1 + 1];+ if (value >= 100000)+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ + *buffer++ = gDigitsLut[d3];+ *buffer++ = gDigitsLut[d3 + 1];+ *buffer++ = gDigitsLut[d4];+ *buffer++ = gDigitsLut[d4 + 1];+ }+ else {+ // value = aabbbbcccc in decimal+ + const uint32_t a = value / 100000000; // 1 to 42+ value %= 100000000;+ + if (a >= 10) {+ const unsigned i = a << 1;+ *buffer++ = gDigitsLut[i];+ *buffer++ = gDigitsLut[i + 1];+ }+ else+ *buffer++ = '0' + static_cast<char>(a);++ const uint32_t b = value / 10000; // 0 to 9999+ const uint32_t c = value % 10000; // 0 to 9999+ + const uint32_t d1 = (b / 100) << 1;+ const uint32_t d2 = (b % 100) << 1;+ + const uint32_t d3 = (c / 100) << 1;+ const uint32_t d4 = (c % 100) << 1;+ + *buffer++ = gDigitsLut[d1];+ *buffer++ = gDigitsLut[d1 + 1];+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ *buffer++ = gDigitsLut[d3];+ *buffer++ = gDigitsLut[d3 + 1];+ *buffer++ = gDigitsLut[d4];+ *buffer++ = gDigitsLut[d4 + 1];+ }+ return buffer - start;+}++size_t i32toa_branchlut(int32_t value, char* buffer) {+ size_t length = 0;+ if (value < 0) {+ ++length;+ *buffer++ = '-';+ value = -value;+ }++ return length + u32toa_branchlut(static_cast<uint32_t>(value), buffer);+}++size_t u64toa_branchlut(uint64_t value, char* buffer) {+ char* start = buffer;+ if (value < 100000000) {+ uint32_t v = static_cast<uint32_t>(value);+ if (v < 10000) {+ const uint32_t d1 = (v / 100) << 1;+ const uint32_t d2 = (v % 100) << 1;+ + if (v >= 1000)+ *buffer++ = gDigitsLut[d1];+ if (v >= 100)+ *buffer++ = gDigitsLut[d1 + 1];+ if (v >= 10)+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ }+ else {+ // value = bbbbcccc+ const uint32_t b = v / 10000;+ const uint32_t c = v % 10000;+ + const uint32_t d1 = (b / 100) << 1;+ const uint32_t d2 = (b % 100) << 1;+ + const uint32_t d3 = (c / 100) << 1;+ const uint32_t d4 = (c % 100) << 1;+ + if (value >= 10000000)+ *buffer++ = gDigitsLut[d1];+ if (value >= 1000000)+ *buffer++ = gDigitsLut[d1 + 1];+ if (value >= 100000)+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ + *buffer++ = gDigitsLut[d3];+ *buffer++ = gDigitsLut[d3 + 1];+ *buffer++ = gDigitsLut[d4];+ *buffer++ = gDigitsLut[d4 + 1];+ }+ }+ else if (value < 10000000000000000) {+ const uint32_t v0 = static_cast<uint32_t>(value / 100000000);+ const uint32_t v1 = static_cast<uint32_t>(value % 100000000);+ + const uint32_t b0 = v0 / 10000;+ const uint32_t c0 = v0 % 10000;+ + const uint32_t d1 = (b0 / 100) << 1;+ const uint32_t d2 = (b0 % 100) << 1;+ + const uint32_t d3 = (c0 / 100) << 1;+ const uint32_t d4 = (c0 % 100) << 1;++ const uint32_t b1 = v1 / 10000;+ const uint32_t c1 = v1 % 10000;+ + const uint32_t d5 = (b1 / 100) << 1;+ const uint32_t d6 = (b1 % 100) << 1;+ + const uint32_t d7 = (c1 / 100) << 1;+ const uint32_t d8 = (c1 % 100) << 1;++ if (value >= 1000000000000000)+ *buffer++ = gDigitsLut[d1];+ if (value >= 100000000000000)+ *buffer++ = gDigitsLut[d1 + 1];+ if (value >= 10000000000000)+ *buffer++ = gDigitsLut[d2];+ if (value >= 1000000000000)+ *buffer++ = gDigitsLut[d2 + 1];+ if (value >= 100000000000)+ *buffer++ = gDigitsLut[d3];+ if (value >= 10000000000)+ *buffer++ = gDigitsLut[d3 + 1];+ if (value >= 1000000000)+ *buffer++ = gDigitsLut[d4];+ if (value >= 100000000)+ *buffer++ = gDigitsLut[d4 + 1];+ + *buffer++ = gDigitsLut[d5];+ *buffer++ = gDigitsLut[d5 + 1];+ *buffer++ = gDigitsLut[d6];+ *buffer++ = gDigitsLut[d6 + 1];+ *buffer++ = gDigitsLut[d7];+ *buffer++ = gDigitsLut[d7 + 1];+ *buffer++ = gDigitsLut[d8];+ *buffer++ = gDigitsLut[d8 + 1];+ }+ else {+ const uint32_t a = static_cast<uint32_t>(value / 10000000000000000); // 1 to 1844+ value %= 10000000000000000;+ + if (a < 10)+ *buffer++ = '0' + static_cast<char>(a);+ else if (a < 100) {+ const uint32_t i = a << 1;+ *buffer++ = gDigitsLut[i];+ *buffer++ = gDigitsLut[i + 1];+ }+ else if (a < 1000) {+ *buffer++ = '0' + static_cast<char>(a / 100);+ + const uint32_t i = (a % 100) << 1;+ *buffer++ = gDigitsLut[i];+ *buffer++ = gDigitsLut[i + 1];+ }+ else {+ const uint32_t i = (a / 100) << 1;+ const uint32_t j = (a % 100) << 1;+ *buffer++ = gDigitsLut[i];+ *buffer++ = gDigitsLut[i + 1];+ *buffer++ = gDigitsLut[j];+ *buffer++ = gDigitsLut[j + 1];+ }+ + const uint32_t v0 = static_cast<uint32_t>(value / 100000000);+ const uint32_t v1 = static_cast<uint32_t>(value % 100000000);+ + const uint32_t b0 = v0 / 10000;+ const uint32_t c0 = v0 % 10000;+ + const uint32_t d1 = (b0 / 100) << 1;+ const uint32_t d2 = (b0 % 100) << 1;+ + const uint32_t d3 = (c0 / 100) << 1;+ const uint32_t d4 = (c0 % 100) << 1;+ + const uint32_t b1 = v1 / 10000;+ const uint32_t c1 = v1 % 10000;+ + const uint32_t d5 = (b1 / 100) << 1;+ const uint32_t d6 = (b1 % 100) << 1;+ + const uint32_t d7 = (c1 / 100) << 1;+ const uint32_t d8 = (c1 % 100) << 1;+ + *buffer++ = gDigitsLut[d1];+ *buffer++ = gDigitsLut[d1 + 1];+ *buffer++ = gDigitsLut[d2];+ *buffer++ = gDigitsLut[d2 + 1];+ *buffer++ = gDigitsLut[d3];+ *buffer++ = gDigitsLut[d3 + 1];+ *buffer++ = gDigitsLut[d4];+ *buffer++ = gDigitsLut[d4 + 1];+ *buffer++ = gDigitsLut[d5];+ *buffer++ = gDigitsLut[d5 + 1];+ *buffer++ = gDigitsLut[d6];+ *buffer++ = gDigitsLut[d6 + 1];+ *buffer++ = gDigitsLut[d7];+ *buffer++ = gDigitsLut[d7 + 1];+ *buffer++ = gDigitsLut[d8];+ *buffer++ = gDigitsLut[d8 + 1];+ }+ + return buffer - start;+}++size_t i64toa_branchlut(int64_t value, char* buffer) {+ size_t length = 0;+ if (value < 0) {+ ++length;+ *buffer++ = '-';+ value = -value;+ }++ return length + u64toa_branchlut(static_cast<uint64_t>(value), buffer);+}
buffer-builder.cabal view
@@ -1,9 +1,9 @@ name: buffer-builder-version: 0.1.0.0+version: 0.2.0.0 synopsis: Library for efficiently building up buffers, one piece at a time description: - 'BufferBuilder' is an efficient library for incrementally building+ "Data.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@@ -15,15 +15,15 @@ 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:+ I benchmarked four approaches with a URL encoding benchmark: .- * State monad, concatenating ByteStrings: __6.98 us__+ * State monad, concatenating ByteStrings: 6.98 us .- * State monad, ByteString Builder: __2.48 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)+ * 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__+ * C + FFI + ReaderT: 1.11 us . Using BufferBuilder is very simple: .@@ -33,13 +33,15 @@ > BB.appendBS "http" > BB.appendChar8 '/' > BB.appendBS "//"- + .+ This package also provides "Data.BufferBuilder.Utf8" for generating UTF-8 buffers+ and "Data.BufferBuilder.Json" for encoding data structures into JSON. license: BSD3 license-file: LICENSE-author: Chad Austin+author: Chad Austin, Andy Friesen maintainer: chad@chadaustin.me-copyright: IMVU Inc., Chad Austin+copyright: IMVU Inc., Chad Austin, Andy Friesen category: Data build-type: Simple stability: experimental@@ -49,15 +51,20 @@ library exposed-modules: Data.BufferBuilder+ Data.BufferBuilder.Utf8+ Data.BufferBuilder.Json build-depends: base ==4.* , bytestring , mtl+ , text+ , vector+ , unordered-containers default-language: Haskell2010 ghc-options: -O2 -Wall - c-sources: buffer.cpp+ c-sources: buffer.cpp branchlut.cpp cc-options: -O2 -Wall test-suite tests@@ -69,19 +76,74 @@ build-depends: base ==4.* , buffer-builder+ , text , tasty , tasty-hunit , tasty-th+ , tasty-quickcheck , HUnit+ , text+ , vector+ , bytestring+ , attoparsec+ , aeson 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+ ghc-options: -O2 -Wall+ --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file build-depends: base ==4.* , bytestring , buffer-builder , criterion++benchmark json-bench+ type: exitcode-stdio-1.0+ main-is: JsonBench.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -O2 -Wall+ --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file+ build-depends: base+ , buffer-builder+ , aeson+ , bytestring+ , text+ , deepseq+ , vector+ , criterion+ , vector++test-suite tinyjson+ type: exitcode-stdio-1.0+ main-is: TinyJson.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -O2 -Wall+ --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file+ build-depends: base+ , buffer-builder+ , aeson+ , bytestring+ , text+ , deepseq+ , criterion++test-suite tinyjson2+ type: exitcode-stdio-1.0+ main-is: TinyJson2.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -O2 -Wall+ --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file+ build-depends: base+ , buffer-builder+ , aeson+ , bytestring+ , deepseq+ , criterion+ , vector
buffer.cpp view
@@ -2,15 +2,49 @@ #include <stdio.h> #include <stdlib.h> #include <string.h>+#include <stdint.h> +#include "branchlut.h"+ const size_t TRIM_THRESHOLD = 8192; // minimum number of bytes saved to trim +/*+ * Append utf8, ASCII7, raw bytes, utf16+ * JSON encode utf8, ascii7, utf16+ */++#if defined(__clang__)+ #define BW_NOINLINE __attribute__((noinline))+#elif defined(__GNUC__)+ #define BW_NOINLINE __attribute__((noinline))+#else+ #define BW_NOINLINE+#endif+ namespace { struct BufferWriter { unsigned char* data; size_t size; size_t capacity; };++ BW_NOINLINE void actuallyGrow(BufferWriter* bw, size_t amount) {+ size_t newCapacity = bw->capacity;+ do {+ newCapacity *= 2;+ } while (newCapacity < bw->size + amount);+ + unsigned char* newData = reinterpret_cast<unsigned char*>(realloc(bw->data, newCapacity));+ assert(newData);+ bw->data = newData;+ bw->capacity = newCapacity;+ }++ inline void grow(BufferWriter* bw, size_t amount) {+ if (bw->size + amount > bw->capacity) {+ actuallyGrow(bw, amount);+ }+ } } // assumes malloc will not fail@@ -32,37 +66,6 @@ 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; }@@ -83,3 +86,204 @@ return data; } +extern "C" void bw_append_byte(BufferWriter* bw, unsigned char byte) {+ assert(bw->data);+ grow(bw, 1);+ bw->data[bw->size] = byte;+ bw->size += 1;+}++extern "C" void bw_append_char_utf8(BufferWriter* bw, uint32_t c) {+ assert(bw->data);+ grow(bw, 4);++ size_t size = bw->size;+ unsigned char* data = bw->data + size;++ if (c <= 0x7F) {+ data[0] = static_cast<unsigned char>(c);+ size += 1;+ } else if (c <= 0x7FF) {+ data[0] = static_cast<unsigned char>(0xC0 | (c >> 6));+ data[1] = static_cast<unsigned char>(0x80 | (c & 0x3F));+ size += 2;+ } else if (c <= 0xFFFF) {+ data[0] = static_cast<unsigned char>(0xE0 | (c >> 12));+ data[1] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));+ data[2] = static_cast<unsigned char>(0x80 | (c & 0x3F));+ size += 3;+ } else if (c <= 0x1FFFFF) {+ data[0] = static_cast<unsigned char>(0xF0 | (c >> 18));+ data[1] = static_cast<unsigned char>(0x80 | ((c >> 12) & 0x3F));+ data[2] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));+ data[3] = static_cast<unsigned char>(0x80 | (c & 0x3F));+ size += 4;+ } else {+ // Unicode characters out of this range are illegal...+ // should we assert? or just ignore...+ }+ bw->size = size;+}++extern "C" void bw_append_bs(BufferWriter* bw, size_t size, const unsigned char* data) {+ assert(bw->data);+ grow(bw, size);++ memcpy(bw->data + bw->size, data, size);+ bw->size += size;+}++extern "C" void bw_append_bsz(BufferWriter* bw, const unsigned char* data) {+ bw_append_bs(bw, strlen(reinterpret_cast<const char*>(data)), data);+}++extern "C" void bw_append_byte7(BufferWriter* bw, unsigned char byte) {+ assert(bw->data);+ grow(bw, 1);+ bw->data[bw->size] = byte & 0x7F;+ bw->size += 1;+}++extern "C" void bw_append_bs7(BufferWriter* bw, size_t size, const unsigned char* data) {+ assert(bw->data);+ grow(bw, size);++ unsigned char* out = bw->data + bw->size;+ for (size_t i = 0; i < size; ++i) {+ out[i] = data[i] & 0x7F;+ }+ bw->size += size;+}++extern "C" void bw_append_bsz7(BufferWriter* bw, const unsigned char* data) {+ bw_append_bs7(bw, strlen(reinterpret_cast<const char*>(data)), data);+}++extern "C" void bw_append_json_escaped(BufferWriter* bw, size_t size, const unsigned char* data) {+ assert(bw->data);+ grow(bw, 2 + size * 2);++ unsigned char* dest = bw->data + bw->size;+ *dest++ = '\"';++ size_t i = 0;+ while (i < size) {+ switch (data[i]) {+ case '\n': *dest++ = '\\'; *dest++ = 'n'; break;+ case '\r': *dest++ = '\\'; *dest++ = 'r'; break;+ case '\t': *dest++ = '\\'; *dest++ = 't'; break;+ case '\\': *dest++ = '\\'; *dest++ = '\\'; break;+ case '\"': *dest++ = '\\'; *dest++ = '\"'; break;+ default: *dest++ = data[i];+ }+ ++i;+ }++ *dest++ = '\"';+ bw->size = dest - bw->data;+}++extern "C" void bw_append_decimal_signed_int(BufferWriter* bw, int64_t i) {+ assert(bw->data);+ grow(bw, 32); // enough++ unsigned used = i64toa_branchlut(i, reinterpret_cast<char*>(bw->data + bw->size));+ bw->size += used;+}++extern "C" void bw_append_decimal_double(BufferWriter* bw, double d) {+ assert(bw->data);+ grow(bw, 30); // ???++ size_t used = sprintf(reinterpret_cast<char*>(bw->data + bw->size), "%f", d);+ bw->size += used;+}++// From <https://github.com/bos/text/blob/f74427c954fb4479f9db5025f27775e29ace125f/cbits/cbits.c#L234>+extern "C" void bw_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff, size_t srclen) {+ const uint16_t *srcend;+ uint8_t *dest = *destp;++ src += srcoff;+ srcend = src + srclen;++ ascii:+#if defined(__x86_64__)+ while (srcend - src >= 4) {+ uint64_t w = *((uint64_t *) src);++ if (w & 0xFF80FF80FF80FF80ULL) {+ if (!(w & 0x000000000000FF80ULL)) {+ *dest++ = w & 0xFFFF;+ src++;+ if (!(w & 0x00000000FF800000ULL)) {+ *dest++ = (w >> 16) & 0xFFFF;+ src++;+ if (!(w & 0x0000FF8000000000ULL)) {+ *dest++ = (w >> 32) & 0xFFFF;+ src++;+ }+ }+ }+ break;+ }+ *dest++ = w & 0xFFFF;+ *dest++ = (w >> 16) & 0xFFFF;+ *dest++ = (w >> 32) & 0xFFFF;+ *dest++ = w >> 48;+ src += 4;+ }+#endif++#if defined(__i386__)+ while (srcend - src >= 2) {+ uint32_t w = *((uint32_t *) src);++ if (w & 0xFF80FF80)+ break;+ *dest++ = w & 0xFFFF;+ *dest++ = w >> 16;+ src += 2;+ }+#endif++ while (src < srcend) {+ uint16_t w = *src++;++ if (w <= 0x7F) {+ *dest++ = w;+ /* An ASCII byte is likely to begin a run of ASCII bytes.+ Falling back into the fast path really helps performance. */+ goto ascii;+ }+ else if (w <= 0x7FF) {+ *dest++ = (w >> 6) | 0xC0;+ *dest++ = (w & 0x3f) | 0x80;+ }+ else if (w < 0xD800 || w > 0xDBFF) {+ *dest++ = (w >> 12) | 0xE0;+ *dest++ = ((w >> 6) & 0x3F) | 0x80;+ *dest++ = (w & 0x3F) | 0x80;+ } else {+ uint32_t c = ((((uint32_t) w) - 0xD800) << 10) ++ (((uint32_t) *src++) - 0xDC00) + 0x10000;+ *dest++ = (c >> 18) | 0xF0;+ *dest++ = ((c >> 12) & 0x3F) | 0x80;+ *dest++ = ((c >> 6) & 0x3F) | 0x80;+ *dest++ = (c & 0x3F) | 0x80;+ }+ }++ *destp = dest;+}++extern "C" void bw_append_json_escaped_utf16(BufferWriter* bw, size_t size, unsigned short* words) {+ unsigned char* utf8 = reinterpret_cast<unsigned char*>(malloc(size * 4));+ unsigned char* utf8end = utf8;++ bw_encode_utf8(&utf8end, words, 0, size);++ bw_append_json_escaped(bw, utf8end - utf8, utf8);++ free(utf8);+}
test/Main.hs view
@@ -1,29 +1,17 @@-{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell, OverloadedStrings, MagicHash #-} 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+import qualified BufferTest+import qualified Utf8Test+import qualified JsonTest -tests :: TestTree-tests = $(testGroupGenerator)+allTests :: TestTree+allTests = testGroup "all tests"+ [ BufferTest.tests+ , Utf8Test.tests+ , JsonTest.tests+ ] main :: IO ()-main = defaultMain tests+main = defaultMain allTests