mason 0.1 → 0.2

raw patch · 5 files changed

+369/−97 lines, 5 filesdep +arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: array

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• mason.cabal +11/−3
• src/Mason/Builder.hs +205/−21
• src/Mason/Builder/Dynamic.hs +60/−0
• src/Mason/Builder/Internal.hs +85/−73

@@ -1,5 +1,13 @@ # Revision history for mason +## 0.2++* Added `doubleFixed`, `doubleSI` and `doubleExp`+* Added `textUtf8`+* Added `prefixVarInt`, `wordVLQ` and `intVLQ`+* Renamed `padded` and `zeroPadded` to `paddedBoundedPrim` and `zeroPaddedBoundedPrim` respectively+* Added `Mason.Builder.Dynamic`+ ## 0 -- 2019-12-05  * First version. Released on an unsuspecting world.

@@ -1,23 +1,30 @@ cabal-version:       2.4  name:                mason-version:             0.1+version:             0.2 synopsis:            Fast and extensible bytestring builder-description:         See README.md+description:+  This package provides efficient implementation of bytestring builders.+  See README.md for details bug-reports:         https://github.com/fumieval/mason/issues license:             BSD-3-Clause license-file:        LICENSE author:              Fumiaki Kinoshita 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+copyright:           2020 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, README.md tested-with:         GHC == 8.6.5, GHC==8.8.1 +source-repository head+  type: git+  location: https://github.com/fumieval/mason.git+ library   exposed-modules:     Mason.Builder     Mason.Builder.Internal+    Mason.Builder.Dynamic    c-sources: cbits/dtoa.c   ghc-options: -Wall -O2@@ -27,5 +34,6 @@     , network >= 2.7 && <3.2     , integer-gmp     , ghc-prim+    , array   hs-source-dirs: src   default-language:    Haskell2010

@@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash, CPP, UnboxedTuples #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE LambdaCase #-} ---------------------------------------------------------------------------- -- | -- Module      :  Mason.Builders@@ -22,11 +23,21 @@   , sendBuilder   -- * Primitives   , flush-  , encodeUtf8Builder-  , encodeUtf8BuilderEscaped+  -- * Bytes   , byteString   , lazyByteString   , shortByteString+  -- * Text+  , textUtf8+  , encodeUtf8Builder+  , encodeUtf8BuilderEscaped+  , char7+  , string7+  , char8+  , string8+  , charUtf8+  , stringUtf8+  -- * Primitive   , storable   , int8   , word8@@ -46,14 +57,12 @@   , word64BE   , floatBE   , doubleBE-  , char7-  , string7-  , char8-  , string8-  , charUtf8-  , stringUtf8+  -- * Numeral   , floatDec   , doubleDec+  , doubleSI+  , doubleExp+  , doubleFixed   , word8Dec   , word16Dec   , word32Dec@@ -82,22 +91,32 @@   , doubleHexFixed   , byteStringHex   , lazyByteStringHex+  -- * Variable-length encoding+  , intVLQ+  , intVLQBP+  , wordVLQ+  , wordVLQBP+  , prefixVarInt+  , prefixVarIntBP   -- * Advanced-  , padded-  , zeroPadded+  , paddedBoundedPrim+  , zeroPaddedBoundedPrim   , primFixed   , primBounded   , lengthPrefixedWithin   ) where  import Control.Monad+import qualified Data.Array as A import Data.Bits import Data.Word import Data.Int import qualified Data.Text as T import Foreign.C.Types-import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Ptr (Ptr, plusPtr, castPtr)+import Foreign.Storable import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as BL import Mason.Builder.Internal as B import qualified Data.ByteString.Builder.Prim as P@@ -107,7 +126,7 @@ import System.IO (Handle)  -- | Put the content of a 'Builder' to a 'Handle'.-hPutBuilder :: Handle -> BuilderFor PutBuilderEnv -> IO ()+hPutBuilder :: Handle -> BuilderFor PutEnv -> IO () hPutBuilder h b = void $ hPutBuilderLen h b {-# INLINE hPutBuilder #-} @@ -259,11 +278,16 @@ charUtf8 :: Char -> Builder charUtf8 = B.primBounded P.charUtf8 --- | Encode 'T.Text' as a UTF-8 byte stream.+-- | Encode 'T.Text' as a UTF-8 byte stream. Synonym for 'textUtf8'. encodeUtf8Builder :: T.Text -> Builder-encodeUtf8Builder = B.encodeUtf8BuilderEscaped (P.liftFixedToBounded P.word8)+encodeUtf8Builder = textUtf8 {-# INLINE encodeUtf8Builder #-} +-- | Encode 'T.Text' as a UTF-8 byte stream.+textUtf8 :: T.Text -> Builder+textUtf8 = B.encodeUtf8BuilderEscaped (P.liftFixedToBounded P.word8)+{-# INLINE textUtf8 #-}+ -------------------- -- Unsigned integers --------------------@@ -301,16 +325,21 @@ floatDec :: Float -> Builder floatDec = string7 . show +wrapDoubleDec :: (Double -> Builder) -> Double -> Builder+wrapDoubleDec k x+  | isNaN x = string7 "NaN"+  | isInfinite x = if x < 0 then string7 "-Infinity" else string7 "Infinity"+  | isNegativeZero x = char7 '-' <> k 0.0+  | x < 0 = char7 '-' <> k (-x)+  | otherwise = k x+{-# INLINE wrapDoubleDec #-}+ -- | Decimal encoding of an IEEE 'Double'. {-# INLINE doubleDec #-} doubleDec :: Double -> Builder-doubleDec x-  | isNaN x = string7 "NaN"-  | isInfinite x = if x < 0 then string7 "-Infinity" else string7 "Infinity"-  | x < 0 = char7 '-' <> grisu (-x)-  | isNegativeZero x = string7 "-0.0"-  | x == 0 = string7 "0.0"-  | otherwise = grisu x+doubleDec = wrapDoubleDec $ \case+  0 -> string7 "0.0"+  x -> grisu x   where     grisu v = withPtr 24 $ \ptr -> do       n <- dtoa_grisu3 v ptr@@ -319,6 +348,93 @@ foreign import ccall unsafe "static dtoa_grisu3"   dtoa_grisu3 :: Double -> Ptr Word8 -> IO CInt +-- | Attach an SI prefix so that abs(mantissa) is within [1, 1000). Omits c, d, da and h.+doubleSI :: Int -- ^ precision: must be equal or greater than 3+  -> Double+  -> Builder+doubleSI prec | prec < 3 = error "Mason.Builder.doubleSI: precision less than 3"+doubleSI prec = wrapDoubleDec $ \case+  0 -> zeroes prec+  val -> Builder $ \env buf -> withGrisu3Rounded prec val $ \ptr len e -> do+    let (pindex, dp) = divMod (e - 1) 3+    print (dp, prec, len)+    let mantissa+          -- when the decimal separator would be at the end+          | dp + 1 == prec = withPtr (prec + dp - 2) $ \dst -> do+            _ <- B.memset dst 48 $ fromIntegral (prec + dp - 2)+            B.memcpy dst ptr $ min len prec+            return $ dst `plusPtr` (prec + dp - 2)+          | otherwise = withPtr (prec + 1) $ \dst -> do+            _ <- B.memset dst 48 $ fromIntegral (prec + 1)+            B.memcpy dst ptr $ min len $ dp + 1+            pokeElemOff dst (dp + 1) 46+            B.memcpy (dst `plusPtr` (dp + 2)) (ptr `plusPtr` (dp + 1)) $ max 0 $ len - dp - 1+            return $ dst `plusPtr` (prec + 1)+    let prefix+          | pindex == 0 = mempty+          | pindex > 8 || pindex < (-8) = char7 'e' <> intDec (3 * pindex)+          | otherwise = charUtf8 (prefices A.! pindex)+    unBuilder (mantissa <> prefix) env buf+  where+    prefices = A.listArray (-8,8) "yzafpnμm\NULkMGTPEZY"++zeroes :: Int -> Builder+zeroes n = withPtr (n + 1) $ \dst -> do+  _ <- B.memset dst 48 $ fromIntegral $ n + 1+  pokeElemOff dst 1 46+  return $ dst `plusPtr` (n + 1)++-- | Always use exponents+doubleExp :: Int -- ^ number of digits in the mantissa+  -> Double+  -> Builder+doubleExp prec | prec < 1 = error "Mason.Builder.doubleFixed: precision too small"+doubleExp prec = wrapDoubleDec $ \case+  0 -> zeroes prec <> string7 "e0"+  val -> Builder $ \env buf -> withGrisu3Rounded prec val $ \ptr len dp -> do+    let len' = 1 + prec++    firstDigit <- peek ptr++    unBuilder (withPtr len' (\dst -> do+      _ <- B.memset dst 48 $ fromIntegral len'+      poke dst firstDigit+      poke (dst `plusPtr` 1) (46 :: Word8)+      B.memcpy (dst `plusPtr` 2) (ptr `plusPtr` 1) (min (len - 1) len')+      return (dst `plusPtr` len'))+      <> char7 'e' <> intDec (dp - 1)) env buf++-- | Fixed precision+doubleFixed :: Int -- ^ decimal points+  -> Double+  -> Builder+doubleFixed 0 = intDec . round+doubleFixed prec | prec < 0 = error "Mason.Builder.doubleFixed: negative precision"+doubleFixed prec = wrapDoubleDec $ \case+  0 -> zeroes (prec + 1)+  val -> Builder $ \env buf -> withGrisu3 val (unBuilder (doubleDec val) env buf) $ \ptr0 len e0 -> do+    bump <- roundDigit (prec + e0) len ptr0+    let dp+          | bump = e0 + 1+          | otherwise = e0+    let ptr+          | bump = ptr0+          | otherwise = ptr0 `plusPtr` 1+    let len' = 1 + prec + max 1 dp++    unBuilder (withPtr len' $ \dst -> do+      _ <- B.memset dst 48 $ fromIntegral len'+      if dp >= 1+        then do+          B.memcpy dst ptr $ min len dp+          pokeElemOff dst dp 46+          B.memcpy (dst `plusPtr` (dp + 1)) (ptr `plusPtr` dp) $ max 0 (len - dp)+        else do+          pokeElemOff dst 1 46+          B.memcpy (dst `plusPtr` (2 - dp)) ptr len+      return $ dst `plusPtr` len'+      ) env buf+ ------------------------------------------------------------------------------ -- Decimal Encoding ------------------------------------------------------------------------------@@ -534,3 +650,71 @@ intDecPadded = P.liftFixedToBounded $ caseWordSize_32_64     (P.fixedPrim  9 $ c_int_dec_padded9            . fromIntegral)     (P.fixedPrim 18 $ c_long_long_int_dec_padded18 . fromIntegral)++-- Variable-length encoding+----++-- | Signed VLQ encoding (the first bit is a sign)+intVLQ :: Int -> Builder+intVLQ = primBounded intVLQBP+{-# INLINE intVLQ #-}++intVLQBP :: P.BoundedPrim Int+intVLQBP = P.boudedPrim 10 writeIntFinite+{-# INLINE CONLIKE intVLQBP #-}++-- | Unsigned VLQ encoding+wordVLQ :: Word -> Builder+wordVLQ = primBounded wordVLQBP++wordVLQBP :: P.BoundedPrim Word+wordVLQBP = P.boudedPrim 10 (writeUnsignedFinite pure)++writeWord8 :: Word8 -> Ptr Word8 -> IO (Ptr Word8)+writeWord8 w p = do+  poke p w+  return $! plusPtr p 1++writeIntFinite :: Int -> Ptr Word8 -> IO (Ptr Word8)+writeIntFinite n+  | n < 0 = case negate n of+    n'+      | n' < 0x40 -> writeWord8 (fromIntegral n' `setBit` 6)+      | otherwise ->+          writeWord8 (0xc0 .|. fromIntegral n') >=>+            writeUnsignedFinite pure (unsafeShiftR n' 6)+  | n < 0x40 = writeWord8 (fromIntegral n)+  | otherwise = writeWord8 (fromIntegral n `setBit` 7 `clearBit` 6) >=>+      writeUnsignedFinite pure (unsafeShiftR n 6)+{-# INLINE writeIntFinite #-}++writeUnsignedFinite :: (Bits a, Integral a) => (Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r+writeUnsignedFinite k = go+  where+    go m+      | m < 0x80 = writeWord8 (fromIntegral m) >=> k+      | otherwise = writeWord8 (setBit (fromIntegral m) 7) >=> go (unsafeShiftR m 7)+{-# INLINE writeUnsignedFinite #-}++-- | Encode a Word in <https://github.com/stoklund/varint#prefixvarint PrefixVarInt>+prefixVarInt :: Word -> Builder+prefixVarInt = primBounded prefixVarIntBP++prefixVarIntBP :: P.BoundedPrim Word+prefixVarIntBP = P.boudedPrim 9 $ \x ptr0 -> do+  let bits = 64 - countLeadingZeros (x .|. 1)+  if bits > 56+    then do+      poke ptr0 0+      poke (castPtr ptr0 `plusPtr` 1) x+      return $! ptr0 `plusPtr` 9+    else do+      let bytes = 1 + (bits - 1) `div` 7+      let end = ptr0 `plusPtr` bytes+      let go ptr n+            | ptr == end = pure ptr+            | otherwise = do+              poke ptr (fromIntegral n .&. 0xff)+              go (ptr `plusPtr` 1) (n `shiftR` 8)+      go ptr0 $! (2 * x + 1) `shiftL` (bytes - 1)+{-# INLINE CONLIKE prefixVarIntBP #-}

@@ -0,0 +1,60 @@+module Mason.Builder.Dynamic+  ( DynBuilder+  , DynamicBackend(..)+  -- * Runners+  , toStrictByteString+  , toLazyByteString+  , hPutBuilderLen+  , hPutBuilder+  , sendBuilder+  ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Mason.Builder as B+import qualified Mason.Builder.Internal as B+import Network.Socket (Socket)+import System.IO (Handle)++data DynamicBackend = DynGrowingBuffer !B.GrowingBuffer+  | DynChannel !B.Channel+  | DynPutEnv !B.PutEnv++instance B.Buildable DynamicBackend where+  byteString bs = B.Builder $ \env buf -> case env of+    DynGrowingBuffer e -> B.unBuilder (B.byteString bs) e buf+    DynChannel e -> B.unBuilder (B.byteString bs) e buf+    DynPutEnv e -> B.unBuilder (B.byteString bs) e buf+  flush = B.Builder $ \env buf -> case env of+    DynGrowingBuffer e -> B.unBuilder B.flush e buf+    DynChannel e -> B.unBuilder B.flush e buf+    DynPutEnv e -> B.unBuilder B.flush e buf+  allocate n = B.Builder $ \env buf -> case env of+    DynGrowingBuffer e -> B.unBuilder (B.allocate n) e buf+    DynChannel e -> B.unBuilder (B.allocate n) e buf+    DynPutEnv e -> B.unBuilder (B.allocate n) e buf++-- | Builder with a fixed set of backends. This helps reducing code size+-- and unoptimised code especially on complex/recursive structures, at the cost of+-- extensibility.+type DynBuilder = B.BuilderFor DynamicBackend++toStrictByteString :: DynBuilder -> B.ByteString+toStrictByteString b = B.toStrictByteString $ B.Builder $ B.unBuilder b . DynGrowingBuffer+{-# INLINE toStrictByteString #-}++toLazyByteString :: DynBuilder -> BL.ByteString+toLazyByteString b = B.toLazyByteString $ B.Builder $ B.unBuilder b . DynChannel+{-# INLINE toLazyByteString #-}++hPutBuilder :: Handle -> DynBuilder -> IO ()+hPutBuilder h b = B.hPutBuilder h $ B.Builder $ B.unBuilder b . DynPutEnv+{-# INLINE hPutBuilder #-}++hPutBuilderLen :: Handle -> DynBuilder -> IO Int+hPutBuilderLen h b = B.hPutBuilderLen h $ B.Builder $ B.unBuilder b . DynPutEnv+{-# INLINE hPutBuilderLen #-}++sendBuilder :: Socket -> DynBuilder -> IO Int+sendBuilder h b = B.sendBuilder h $ B.Builder $ B.unBuilder b . DynPutEnv+{-# INLINE sendBuilder #-}

@@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE RecordWildCards #-} module Mason.Builder.Internal (Builder   , BuilderFor(..)   , Buildable(..)@@ -21,21 +22,22 @@   , primMapListBounded   , primMapByteStringFixed   , primMapLazyByteStringFixed+  , PutEnv(..)   , hPutBuilderLen-  , PutBuilderEnv(..)   , encodeUtf8BuilderEscaped   , sendBuilder-  , SocketEnv(..)   , cstring   , cstringUtf8   , withPtr   , storable-  , padded-  , zeroPadded+  , paddedBoundedPrim+  , zeroPaddedBoundedPrim   -- * Internal   , ensure   , allocateConstant-  , grisu3+  , withGrisu3+  , withGrisu3Rounded+  , roundDigit   ) where  import Control.Concurrent@@ -66,7 +68,6 @@ import qualified Data.Text.Internal as T import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Network.Socket as S-import qualified Network.Socket.ByteString as S import GHC.Prim (eqWord#, plusAddr#, indexWord8OffAddr#) import GHC.Ptr (Ptr(..)) import GHC.Word (Word8(..))@@ -244,12 +245,13 @@ primMapLazyByteStringFixed fp = BL.foldr (mappend . primFixed fp) mempty {-# INLINE primMapLazyByteStringFixed #-} -padded :: Word8+paddedBoundedPrim+  :: Word8 -- ^ filler   -> Int -- ^ pad if shorter than this   -> B.BoundedPrim a   -> a   -> Builder-padded ch size bp a = ensure (B.sizeBound bp) $ \(Buffer end ptr) -> do+paddedBoundedPrim 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@@ -258,8 +260,8 @@     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+zeroPaddedBoundedPrim :: Int -> B.BoundedPrim a -> a -> Builder+zeroPaddedBoundedPrim = paddedBoundedPrim 48  newtype GrowingBuffer = GrowingBuffer (IORef (ForeignPtr Word8)) @@ -304,7 +306,7 @@  instance Buildable Channel where   byteString bs-    | B.length bs < 3272 = byteStringCopy bs+    | B.length bs < 4096 = byteStringCopy bs     | otherwise = flush <> Builder (\(Channel v _) b -> b <$ putMVar v bs)   {-# INLINE byteString #-}   flush = Builder $ \(Channel v ref) (Buffer end ptr) -> do@@ -321,14 +323,15 @@ toLazyByteString body = unsafePerformIO $ do   resp <- newEmptyMVar -  fptr <- mallocForeignPtrBytes defaultBufferSize+  let initialSize = 4096+  fptr <- mallocForeignPtrBytes initialSize   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` defaultBufferSize) ptr+    $ Buffer (ptr `plusPtr` initialSize) ptr    let go _ = unsafePerformIO $ do         bs <- takeMVar resp@@ -338,11 +341,13 @@   return $ go () {-# INLINE toLazyByteString #-} --- | Environemnt for handle output-data PutBuilderEnv = PBE-  { pbHandle :: !Handle-  , pbBuffer :: !(IORef (ForeignPtr Word8))-  , pbTotal :: !(IORef Int)+-- | Environment for handle output+data PutEnv = PutEnv+  { peThreshold :: !Int+  , pePut :: !(Ptr Word8 -> Ptr Word8 -> IO ())+  -- ^ takes a pointer range and returns the number of bytes written+  , peBuffer :: !(IORef (ForeignPtr Word8))+  , peTotal :: !(IORef Int)   }  -- | Allocate a new buffer.@@ -354,50 +359,44 @@   return $! Buffer (ptr1 `plusPtr` len) ptr1 {-# INLINE allocateConstant #-} -instance Buildable PutBuilderEnv where-  byteString bs-    | len > defaultBufferSize = mappend flush $ Builder $ \(PBE h _ _) buf -> do-      B.hPut h bs-      return buf-    | otherwise = byteStringCopy bs-    where-      len = B.length bs+instance Buildable PutEnv where+  byteString bs@(B.PS fptr ofs len) = Builder $ \env@PutEnv{..} buf -> if len > peThreshold+    then do+      buf' <- unBuilder flush env buf+      withForeignPtr fptr $ \ptr -> do+        let ptr0 = ptr `plusPtr` ofs+        pePut ptr0 (ptr0 `plusPtr` len)+      pure buf'+    else unBuilder (byteStringCopy bs) env buf   {-# INLINE byteString #-} -  flush = Builder $ \(PBE h ref counter) (Buffer end ptr) -> do-    ptr0 <- unsafeForeignPtrToPtr <$> readIORef ref+  flush = Builder $ \PutEnv{..} (Buffer end ptr) -> do+    ptr0 <- unsafeForeignPtrToPtr <$> readIORef peBuffer     let len = minusPtr ptr ptr0-    modifyIORef' counter (+len)-    hPutBuf h ptr0 len+    modifyIORef' peTotal (+len)+    pePut ptr0 ptr     return $! Buffer end ptr0   {-# INLINE flush #-} -  allocate = allocateConstant pbBuffer+  allocate = allocateConstant peBuffer   {-# 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 :: Handle -> BuilderFor PutEnv -> IO Int hPutBuilderLen h b = do-  fptr <- mallocForeignPtrBytes defaultBufferSize+  let initialSize = 4096+  fptr <- mallocForeignPtrBytes initialSize   ref <- newIORef fptr   let ptr = unsafeForeignPtrToPtr fptr   counter <- newIORef 0-  _ <- unBuilder (b <> flush) (PBE h ref counter) (Buffer (ptr `plusPtr` defaultBufferSize) ptr)+  _ <- unBuilder (b <> flush)+    (PutEnv initialSize (\ptr0 ptr1 -> hPutBuf h ptr (minusPtr ptr1 ptr0)) ref counter)+    (Buffer (ptr `plusPtr` initialSize) ptr)   readIORef counter {-# INLINE hPutBuilderLen #-} --- | Environemnt for socket output-data SocketEnv = SE-  { seSocket :: !S.Socket-  , seBuffer :: !(IORef (ForeignPtr Word8))-  , seCounter :: !(IORef Int)-  }- sendBufRange :: S.Socket -> Ptr Word8 -> Ptr Word8 -> IO () sendBufRange sock ptr0 ptr1 = go ptr0 where   go p@@ -407,33 +406,17 @@       S.withFdSocket sock $ threadWaitWrite . fromIntegral       when (sent > 0) $ go $ p `plusPtr` sent -instance Buildable SocketEnv where-  byteString bs-    | len > defaultBufferSize = mappend flush $ Builder $ \(SE sock _ _) (Buffer end ptr) -> do-      S.sendAll sock bs-      return $! Buffer end ptr-    | otherwise = byteStringCopy bs-    where-      len = B.length bs-  {-# INLINE byteString #-}--  flush = Builder $ \(SE sock ref counter) (Buffer end ptr1) -> do-    ptr0 <- unsafeForeignPtrToPtr <$> readIORef ref-    sendBufRange sock ptr0 ptr1-    modifyIORef' counter (+minusPtr ptr1 ptr0)-    return $! Buffer end ptr0-  {-# INLINE flush #-}--  allocate = allocateConstant seBuffer- -- | Write a 'Builder' into a handle and obtain the number of bytes written.-sendBuilder :: S.Socket -> BuilderFor SocketEnv -> IO Int+sendBuilder :: S.Socket -> BuilderFor PutEnv -> IO Int sendBuilder sock b = do-  fptr <- mallocForeignPtrBytes defaultBufferSize+  let initialSize = 4096+  fptr <- mallocForeignPtrBytes initialSize   ref <- newIORef fptr   let ptr = unsafeForeignPtrToPtr fptr   counter <- newIORef 0-  _ <- unBuilder (b <> flush) (SE sock ref counter) (Buffer (ptr `plusPtr` defaultBufferSize) ptr)+  _ <- unBuilder (b <> flush)+    (PutEnv initialSize (sendBufRange sock) ref counter)+    (Buffer (ptr `plusPtr` initialSize) ptr)   readIORef counter {-# INLINE sendBuilder #-} @@ -485,18 +468,47 @@     c_memmove :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()  -- | Decimal encoding of a positive 'Double'.-{-# INLINE grisu3 #-}-grisu3 :: Double -> Maybe (B.ByteString, Int)-grisu3 d = unsafeDupablePerformIO $ allocaArray 2 $ \plen -> do-  fptr <- B.mallocByteString 18+{-# INLINE withGrisu3 #-}+withGrisu3 :: Double -> IO r -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r+withGrisu3 d contFail cont = allocaArray 2 $ \plen -> allocaArray 19 $ \ptr -> do   let pexp = plusPtr plen (S.sizeOf (undefined :: CInt))-  success <- withForeignPtr fptr $ \ptr -> c_grisu3 (realToFrac d) ptr plen pexp+  success <- c_grisu3 (realToFrac d) (ptr `plusPtr` 1) plen pexp   if success == 0-    then return Nothing+    then contFail     else do       len <- fromIntegral <$> S.peek plen       e <- fromIntegral <$> S.peek pexp-      return $ Just (B.PS fptr 0 len, len + e)+      cont ptr len (len + e)++{-# INLINE withGrisu3Rounded #-}+withGrisu3Rounded :: Int -> Double -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r+withGrisu3Rounded prec val cont = withGrisu3 val (error "withGrisu3Rounded: failed") $ \ptr len e -> do+  let len' = min prec len+  bump <- roundDigit prec len ptr+  if bump then cont ptr len' (e + 1) else cont (ptr `plusPtr` 1) len' e++-- | Round up to the supplied precision inplace.+roundDigit+  :: Int -- ^ precision+  -> Int -- ^ available digits+  -> Ptr Word8 -- ^ content+  -> IO Bool+roundDigit prec len _ | prec >= len = pure False+roundDigit prec _ ptr = do+  rd <- peekElemOff ptr (prec + 1)+  let carry 0 = do+        poke ptr 49+        pure True+      carry i = do+        d <- peekElemOff ptr i+        if d == 57+          then pokeElemOff ptr i 48 *> carry (i - 1)+          else do+            pokeElemOff ptr i (d + 1)+            pure False+  if rd >= 53+    then carry prec+    else pure False  foreign import ccall unsafe "static grisu3"   c_grisu3 :: CDouble -> Ptr Word8 -> Ptr CInt -> Ptr CInt -> IO CInt