mason 0.2.4 → 0.2.5
raw patch · 5 files changed
+58/−39 lines, 5 filesdep −integer-gmp
Dependencies removed: integer-gmp
Files
- CHANGELOG.md +4/−0
- mason.cabal +3/−4
- src/Mason/Builder.hs +25/−20
- src/Mason/Builder/Dynamic.hs +3/−0
- src/Mason/Builder/Internal.hs +23/−15
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 0.2.5++* Supported GHC 9.2.1+ ## 0.2.4 * Generalised the argument `intersperse`, `unlines`, `unwords` from a list to any `Foldable`
mason.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: mason-version: 0.2.4+version: 0.2.5 synopsis: Fast and extensible bytestring builder description: This package provides efficient implementation of bytestring builders.@@ -11,10 +11,10 @@ license-file: LICENSE author: Fumiaki Kinoshita maintainer: fumiexcel@gmail.com-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+copyright: 2021 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+tested-with: GHC == 9.2.1, GHC==9.0.1, GHC==8.10.7 source-repository head type: git@@ -33,7 +33,6 @@ , bytestring , text , network >= 2.7 && <3.2- , integer-gmp , ghc-prim , array hs-source-dirs: src
src/Mason/Builder.hs view
@@ -135,8 +135,9 @@ import Mason.Builder.Internal as B import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as P-import GHC.Integer.GMP.Internals-import GHC.Types (Int(..))+#if !MIN_VERSION_bytestring(0,10,12)+import Data.ByteString.Builder.Prim (boudedPrim)+#endif import System.IO (Handle) -- | Put the content of a 'Builder' to a 'Handle'.@@ -587,8 +588,6 @@ lazyByteStringHex :: BL.ByteString -> Builder lazyByteStringHex x = B.primMapLazyByteStringFixed P.word8HexFixed x -#define PAIR(a,b) (# a,b #)- -- | Select an implementation depending on the bit-size of 'Word's. -- Currently, it produces a runtime failure if the bitsize is different. -- This is detected by the testsuite.@@ -612,10 +611,10 @@ -- | Decimal encoding of an 'Integer' using the ASCII digits. -- Simon Meier's improved implementation from https://github.com/haskell/bytestring/commit/92f19a5d94761042b44a433d7331107611e4d717 integerDec :: Integer -> Builder-integerDec (S# i#) = intDec (I# i#) integerDec i- | i < 0 = B.primFixed P.char8 '-' `mappend` go (-i)- | otherwise = go ( i)+ | i' <- fromInteger i, toInteger i' == i = intDec i'+ | i < 0 = primFixed P.char8 '-' `mappend` go (-i)+ | otherwise = go i where errImpossible fun = error $ "integerDec: " ++ fun ++ ": the impossible happened."@@ -624,7 +623,7 @@ go n | n < maxPow10 = intDec (fromInteger n) | otherwise = case putH (splitf (maxPow10 * maxPow10) n) of- (x:xs) -> intDec x `mappend` B.primMapListBounded intDecPadded18 xs+ (x:xs) -> intDec x `mappend` primMapListBounded intDecPadded18 xs [] -> errImpossible "integerDec: go" splitf :: Integer -> Integer -> [Integer]@@ -634,18 +633,18 @@ where splith [] = errImpossible "splith" splith (n:ns) =- case n `quotRemInteger` pow10 of- PAIR(q,r) | q > 0 -> q : r : splitb ns- | otherwise -> r : splitb ns+ case n `quotRem` pow10 of+ (q,r) | q > 0 -> q : r : splitb ns+ | otherwise -> r : splitb ns splitb [] = []- splitb (n:ns) = case n `quotRemInteger` pow10 of- PAIR(q,r) -> q : r : splitb ns+ splitb (n:ns) = case n `quotRem` pow10 of+ (q,r) -> q : r : splitb ns putH :: [Integer] -> [Int] putH [] = errImpossible "putH"- putH (n:ns) = case n `quotRemInteger` maxPow10 of- PAIR(x,y)+ putH (n:ns) = case n `quotRem` maxPow10 of+ (x,y) | q > 0 -> q : r : putB ns | otherwise -> r : putB ns where q = fromInteger x@@ -653,8 +652,9 @@ putB :: [Integer] -> [Int] putB [] = []- putB (n:ns) = case n `quotRemInteger` maxPow10 of- PAIR(q,r) -> fromInteger q : fromInteger r : putB ns+ putB (n:ns) = case n `quotRem` maxPow10 of+ (q,r) -> fromInteger q : fromInteger r : putB ns+{-# INLINE integerDec #-} foreign import ccall unsafe "static _hs_bytestring_int_dec_padded9" c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()@@ -668,6 +668,11 @@ (P.fixedPrim 9 $ c_int_dec_padded9 . fromIntegral) (P.fixedPrim 18 $ c_long_long_int_dec_padded18 . fromIntegral) +#if !MIN_VERSION_bytestring(0,10,12)+boundedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a+boundedPrim = boudedPrim+#endif+ -- Variable-length encoding ---- @@ -677,7 +682,7 @@ {-# INLINE intVLQ #-} intVLQBP :: P.BoundedPrim Int-intVLQBP = P.boudedPrim 10 writeIntFinite+intVLQBP = P.boundedPrim 10 writeIntFinite {-# INLINE CONLIKE intVLQBP #-} -- | Unsigned VLQ encoding@@ -685,7 +690,7 @@ wordVLQ x = primBounded wordVLQBP x wordVLQBP :: P.BoundedPrim Word-wordVLQBP = P.boudedPrim 10 (writeUnsignedFinite pure)+wordVLQBP = P.boundedPrim 10 (writeUnsignedFinite pure) writeWord8 :: Word8 -> Ptr Word8 -> IO (Ptr Word8) writeWord8 w p = do@@ -718,7 +723,7 @@ prefixVarInt x = primBounded prefixVarIntBP x prefixVarIntBP :: P.BoundedPrim Word-prefixVarIntBP = P.boudedPrim 9 $ \x ptr0 -> do+prefixVarIntBP = P.boundedPrim 9 $ \x ptr0 -> do let bits = 64 - countLeadingZeros (x .|. 1) if bits > 56 then do
src/Mason/Builder/Dynamic.hs view
@@ -25,14 +25,17 @@ 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+ {-# INLINE byteString #-} 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+ {-# INLINE flush #-} 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+ {-# INLINE allocate #-} -- | Builder with a fixed set of backends. This helps reducing code size -- and unoptimised code especially on complex/recursive structures, at the cost of
src/Mason/Builder/Internal.hs view
@@ -54,7 +54,7 @@ import Control.Concurrent import Control.Exception (throw) import Control.Monad-import Data.Bits ((.&.))+import Data.Bits ((.&.), shiftR) import qualified Data.ByteString as B import qualified Data.ByteString.Short.Internal as SB import qualified Data.ByteString.Lazy as BL@@ -63,7 +63,6 @@ import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as B-import Data.Text.Internal.Unsafe.Shift (shiftR) import Data.Text.Internal.Unsafe.Char (ord) import System.IO import Foreign.C.Types@@ -80,12 +79,18 @@ import qualified Data.Text.Internal as T import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Network.Socket as S-import GHC.Prim (eqWord#, plusAddr#, indexWord8OffAddr#, RealWorld, Addr#, State# )+import GHC.Prim (plusAddr#, indexWord8OffAddr#, RealWorld, Addr#, State# ) import GHC.Ptr (Ptr(..)) import GHC.Word (Word8(..))-import GHC.Types (isTrue#) import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build, IO(..), unIO) +-- https://www.haskell.org/ghc/blog/20210607-the-keepAlive-story.html+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+unsafeWithForeignPtr fo f = do+ r <- f (unsafeForeignPtrToPtr fo)+ touchForeignPtr fo+ return r+ -- | The Builder type. Requires RankNTypes extension type Builder = forall s. Buildable s => BuilderFor s @@ -126,7 +131,7 @@ -- | Copy a 'B.ByteString' to a buffer. byteStringCopy :: Buildable s => B.ByteString -> BuilderFor s byteStringCopy = \(B.PS fsrc ofs len) -> withPtr len $ \ptr -> do- withForeignPtr fsrc $ \src -> B.memcpy ptr (src `plusPtr` ofs) len+ unsafeWithForeignPtr fsrc $ \src -> B.memcpy ptr (src `plusPtr` ofs) len return $ ptr `plusPtr` len {-# INLINE byteStringCopy #-} @@ -213,7 +218,7 @@ cstring (Ptr addr0) = Builder $ step addr0 where step addr env br@(Buffer end ptr)- | isTrue# (ch `eqWord#` 0##) = pure br+ | W8# ch == 0 = pure br | ptr == end = unBuilder (ensure 3 $ step addr env) env br | otherwise = do S.poke ptr (W8# ch)@@ -227,11 +232,11 @@ cstringUtf8 (Ptr addr0) = Builder $ step addr0 where step addr env br@(Buffer end ptr)- | isTrue# (ch `eqWord#` 0##) = pure br+ | W8# ch == 0 = pure br | ptr == end = unBuilder (ensure 3 $ step addr env) env br -- NULL is encoded as 0xc0 0x80- | isTrue# (ch `eqWord#` 0xc0##)- , isTrue# (indexWord8OffAddr# addr 1# `eqWord#` 0x80##) = do+ | W8# ch == 0xc0+ , W8# (indexWord8OffAddr# addr 1#) == 0x80 = do S.poke ptr 0 step (addr `plusAddr#` 2#) env (Buffer end (ptr `plusPtr` 1)) | otherwise = do@@ -340,7 +345,10 @@ flush = Builder $ \(Channel v ref) (Buffer end ptr) -> do ptr0 <- unsafeForeignPtrToPtr <$> readIORef ref let len = minusPtr ptr ptr0- when (len > 0) $ putMVar v $! B.unsafeCreate len $ \dst -> B.memcpy dst ptr0 len+ when (len > 0) $ do+ bs <- B.mallocByteString len+ unsafeWithForeignPtr bs $ \dst -> B.memcpy dst ptr0 len+ putMVar v $ B.PS bs 0 len return $! Buffer end ptr0 {-# INLINE flush #-} allocate = allocateConstant chBuffer@@ -351,12 +359,12 @@ -- | Create a lazy 'BL.ByteString'. Threaded runtime is required. toLazyByteString :: BuilderFor LazyByteStringBackend -> BL.ByteString toLazyByteString body = unsafePerformIO $ withPopper body $ \pop -> do- let go _ = unsafePerformIO $ do+ let go _ = do bs <- pop return $! if B.null bs then BL.empty- else BL.Chunk bs (go ())- return $ go ()+ else BL.Chunk bs $ unsafePerformIO $ go ()+ return $ unsafePerformIO $ go () {-# INLINE toLazyByteString #-} -- | Use 'Builder' as a <http://hackage.haskell.org/package/http-client-0.7.1/docs/Network-HTTP-Client.html#t:GivesPopper GivesPopper'@@ -369,7 +377,7 @@ ref <- newIORef fptr let ptr = unsafeForeignPtrToPtr fptr - let final (Left e) = throw e+ let final (Left e) = putMVar resp (throw e) final (Right _) = putMVar resp B.empty _ <- flip forkFinally final $ unBuilder (body <> flush) (Channel resp ref) $ Buffer (ptr `plusPtr` initialSize) ptr@@ -399,7 +407,7 @@ 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+ unsafeWithForeignPtr fptr $ \ptr -> do let ptr0 = ptr `plusPtr` ofs pePut ptr0 (ptr0 `plusPtr` len) pure buf'