diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -1,12 +1,11 @@ module Main where -import Prelude hiding (concat) -import Criterion.Main import ByteString.StrictBuilder - +import Criterion.Main +import Prelude hiding (concat) main = - defaultMain [leftAppends, rightAppends, concat] + defaultMain [leftAppends, rightAppends, concat, copy] leftAppends :: Benchmark leftAppends = @@ -20,7 +19,7 @@ rightAppends :: Benchmark rightAppends = - bench "rightAppends" $ whnf action $! replicate 1000 $ bytes "abc" + bench "rightAppends" $ whnf action $! replicate 1000 $ bytes "abc" where action bytesList = builderBytes builder @@ -30,7 +29,15 @@ concat :: Benchmark concat = - bench "concat" $ whnf action $! replicate 10000 $ bytes "abc" + bench "concat" $ whnf action $! replicate 10000 $ bytes "abc" where action bytesList = builderBytes (mconcat bytesList) + +copy :: Benchmark +copy = + bench "copy" $ whnf action $! bytes dat + where + dat = builderBytes $ mconcat $ replicate 1000000 $ bytes "abc" + action bs = + builderBytes bs diff --git a/bytestring-strict-builder.cabal b/bytestring-strict-builder.cabal --- a/bytestring-strict-builder.cabal +++ b/bytestring-strict-builder.cabal @@ -1,5 +1,5 @@ name: bytestring-strict-builder -version: 0.4.5.5 +version: 0.4.5.6 category: Text, ByteString, Builders, Serialization synopsis: An efficient strict bytestring builder description: diff --git a/library/ByteString/StrictBuilder.hs b/library/ByteString/StrictBuilder.hs --- a/library/ByteString/StrictBuilder.hs +++ b/library/ByteString/StrictBuilder.hs @@ -1,39 +1,43 @@ module ByteString.StrictBuilder -( - Builder, - builderBytes, - builderChunksBuilder, - builderLength, - builderPtrFiller, - bytes, - lazyBytes, - asciiIntegral, - asciiChar, - utf8Char, - storable, - word8, - word16BE, - word32BE, - word64BE, - int8, - int16BE, - int32BE, - int64BE, -) + ( Builder, + builderBytes, + builderChunksBuilder, + builderLength, + builderPtrFiller, + bytes, + lazyBytes, + asciiIntegral, + asciiChar, + utf8Char, + storable, + word8, + word16BE, + word32BE, + word64BE, + int8, + int16BE, + int32BE, + int64BE, + ) where -import ByteString.StrictBuilder.Prelude import qualified ByteString.StrictBuilder.Population as A +import ByteString.StrictBuilder.Prelude +import qualified ByteString.StrictBuilder.UTF8 as E import qualified Data.ByteString as B +import qualified Data.ByteString.Builder.Internal as G import qualified Data.ByteString.Internal as C import qualified Data.ByteString.Lazy as F -import qualified Data.ByteString.Builder.Internal as G -import qualified ByteString.StrictBuilder.UTF8 as E +-- * Rewrite rules -data Builder = - Builder !Int !A.Population +{-# RULES "builderBytes/bytes" forall a. builderBytes (bytes a) = a #-} +-- * Builder + +data Builder + = Builder !Int !A.Population + instance Semigroup Builder where (<>) (Builder leftSize leftPopulation) (Builder rightSize rightPopulation) = Builder (leftSize + rightSize) (leftPopulation <> rightPopulation) @@ -67,52 +71,48 @@ show = show . builderBytes - --- * ------------------------- -{-| -Efficiently constructs a strict bytestring. --} -{-# INLINE builderBytes #-} +-- | +-- Efficiently constructs a strict bytestring. +{-# NOINLINE builderBytes #-} builderBytes :: Builder -> ByteString builderBytes (Builder size population) = C.unsafeCreate size $ \ptr -> A.populationPtrUpdate population ptr $> () -{-| -Converts into the standard lazy bytestring builder. -Does so efficiently using the internal APIs of \"bytestring\", -without producing any intermediate representation. --} +-- | +-- Converts into the standard lazy bytestring builder. +-- Does so efficiently using the internal APIs of \"bytestring\", +-- without producing any intermediate representation. {-# INLINE builderChunksBuilder #-} builderChunksBuilder :: Builder -> G.Builder builderChunksBuilder (Builder size population) = G.ensureFree size <> A.populationChunksBuilder population -{-| -/O(1)/. Gets the size of the bytestring that is to be produced. --} +-- | +-- /O(1)/. Gets the size of the bytestring that is to be produced. {-# INLINE builderLength #-} builderLength :: Builder -> Int builderLength (Builder size population) = size -{-| -Use the builder to populate a buffer. -It is your responsibility to ensure that the bounds are not exceeded. --} +-- | +-- Use the builder to populate a buffer. +-- It is your responsibility to ensure that the bounds are not exceeded. {-# INLINE builderPtrFiller #-} builderPtrFiller :: - Builder -> - (Int -> (Ptr Word8 -> IO ()) -> result) {-^ A continuation on the amount of bytes to be written and the action populating the pointer. -} -> result + Builder -> + -- | A continuation on the amount of bytes to be written and the action populating the pointer. + (Int -> (Ptr Word8 -> IO ()) -> result) -> + result builderPtrFiller (Builder size (A.Population ptrUpdate)) cont = cont size (void . ptrUpdate) - -- * Primitives + ------------------------- -{-# INLINE bytes #-} +{-# NOINLINE bytes #-} bytes :: ByteString -> Builder bytes bytes = Builder (B.length bytes) (A.bytes bytes) @@ -127,11 +127,11 @@ byte = word8 - -- * Extras + ------------------------- -{-# INLINABLE asciiIntegral #-} +{-# INLINEABLE asciiIntegral #-} asciiIntegral :: Integral a => a -> Builder asciiIntegral = \case @@ -139,8 +139,8 @@ byte 48 x -> bool ((<>) (byte 45)) id (x >= 0) $ - loop mempty $ - abs x + loop mempty $ + abs x where loop builder remainder = case remainder of @@ -228,4 +228,3 @@ bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder bytes_4 b1 b2 b3 b4 = Builder 4 (A.bytes_4 b1 b2 b3 b4) - diff --git a/library/ByteString/StrictBuilder/Population.hs b/library/ByteString/StrictBuilder/Population.hs --- a/library/ByteString/StrictBuilder/Population.hs +++ b/library/ByteString/StrictBuilder/Population.hs @@ -1,16 +1,15 @@ {-# LANGUAGE CPP #-} + module ByteString.StrictBuilder.Population where +import qualified ByteString.StrictBuilder.Population.UncheckedShifting as D import ByteString.StrictBuilder.Prelude +import qualified ByteString.StrictBuilder.UTF8 as E +import qualified Data.ByteString.Builder.Internal as G import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy.Internal as C -import qualified Data.ByteString.Builder.Internal as G -import qualified ByteString.StrictBuilder.Population.UncheckedShifting as D -import qualified ByteString.StrictBuilder.UTF8 as E - -newtype Population = - Population { populationPtrUpdate :: Ptr Word8 -> IO (Ptr Word8) } +newtype Population = Population {populationPtrUpdate :: Ptr Word8 -> IO (Ptr Word8)} instance Semigroup Population where (<>) (Population leftPtrUpdate) (Population rightPtrUpdate) = @@ -21,10 +20,8 @@ mempty = Population return - -{-| -Turns into the standard lazy bytestring builder. --} +-- | +-- Turns into the standard lazy bytestring builder. {-# INLINE populationChunksBuilder #-} populationChunksBuilder :: Population -> G.Builder populationChunksBuilder (Population ptrUpdate) = @@ -56,8 +53,8 @@ bytes :: B.ByteString -> Population bytes (B.PS foreignPointer offset length) = Population $ \ptr -> - withForeignPtr foreignPointer $ \ptr' -> - B.memcpy ptr (plusPtr ptr' offset) length $> plusPtr ptr length + withForeignPtr foreignPointer $ \ptr' -> + B.memcpy ptr (plusPtr ptr' offset) length $> plusPtr ptr length {-# INLINE storable #-} storable :: Storable a => Int -> a -> Population @@ -68,7 +65,7 @@ word8 :: Word8 -> Population word8 value = Population $ \ptr -> - poke ptr value $> plusPtr ptr 1 + poke ptr value $> plusPtr ptr 1 {-# INLINE word16BE #-} word16BE :: Word16 -> Population diff --git a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs --- a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs +++ b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} + -- | -- Copyright : (c) 2010 Simon Meier -- @@ -11,16 +12,14 @@ -- -- These functions are undefined when the amount being shifted by is -- greater than the size in bits of a machine Int#.- --- -module ByteString.StrictBuilder.Population.UncheckedShifting ( - shiftr_w16 - , shiftr_w32 - , shiftr_w64 - , shiftr_w - - , caseWordSize_32_64 - ) where - +module ByteString.StrictBuilder.Population.UncheckedShifting + ( shiftr_w16, + shiftr_w32, + shiftr_w64, + shiftr_w, + caseWordSize_32_64, + ) +where #if !defined(__HADDOCK__) import GHC.Base @@ -33,9 +32,8 @@ import Data.Word #endif -import Prelude import Foreign - +import Prelude ------------------------------------------------------------------------ -- Unchecked shifts @@ -82,20 +80,26 @@ shiftr_w64 = shiftR #endif - -- | 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. {-# INLINE caseWordSize_32_64 #-} -caseWordSize_32_64 :: a -- Value to use for 32-bit 'Word's - -> a -- Value to use for 64-bit 'Word's - -> a -caseWordSize_32_64 f32 f64 = +caseWordSize_32_64 :: + -- | Value to use for 32-bit 'Word's + a -> + -- | Value to use for 64-bit 'Word's + a -> + a #if MIN_VERSION_base(4,7,0) +caseWordSize_32_64 f32 f64 = case finiteBitSize (undefined :: Word) of + 32 -> f32 + 64 -> f64 + s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s #else +caseWordSize_32_64 f32 f64 = case bitSize (undefined :: Word) of -#endif 32 -> f32 64 -> f64 s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s +#endif diff --git a/library/ByteString/StrictBuilder/Prelude.hs b/library/ByteString/StrictBuilder/Prelude.hs --- a/library/ByteString/StrictBuilder/Prelude.hs +++ b/library/ByteString/StrictBuilder/Prelude.hs @@ -1,24 +1,22 @@ module ByteString.StrictBuilder.Prelude -( - module Exports, -) + ( module Exports, + ) where --- base -------------------------- -import Control.Applicative as Exports hiding (WrappedArrow(..)) +import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports +import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports @@ -30,18 +28,18 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Compose as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') -import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt, (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports -import Data.Semigroup as Exports hiding (First(..), Last(..)) import Data.STRef as Exports +import Data.Semigroup as Exports hiding (First (..), Last (..)) import Data.String as Exports import Data.Traversable as Exports import Data.Tuple as Exports @@ -54,13 +52,12 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith) +import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import Numeric as Exports -import Prelude as Exports hiding (Read, fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -70,10 +67,7 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) +import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) +import Text.Printf as Exports (hPrintf, printf) import Unsafe.Coerce as Exports - --- bytestring -------------------------- -import Data.ByteString as Exports (ByteString) +import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) diff --git a/library/ByteString/StrictBuilder/UTF8.hs b/library/ByteString/StrictBuilder/UTF8.hs --- a/library/ByteString/StrictBuilder/UTF8.hs +++ b/library/ByteString/StrictBuilder/UTF8.hs @@ -1,14 +1,11 @@ -{- | -Utilities for the UTF-8 encoding. --} +-- | +-- Utilities for the UTF-8 encoding. module ByteString.StrictBuilder.UTF8 where import ByteString.StrictBuilder.Prelude - -{-| -Church encoding of a UTF8-encoded character. --} +-- | +-- Church encoding of a UTF8-encoded character. type UTF8Char = forall a. (Word8 -> a) -> @@ -26,24 +23,23 @@ unicodeCodePoint :: Int -> UTF8Char unicodeCodePoint x f1 f2 f3 f4 = if x <= 0x7F - then - f1 (fromIntegral x) - else + then f1 (fromIntegral x) + else if x <= 0x07FF then f2 - (fromIntegral ((x `shiftR` 6) + 0xC0)) - (fromIntegral ((x .&. 0x3F) + 0x80)) + (fromIntegral ((x `shiftR` 6) + 0xC0)) + (fromIntegral ((x .&. 0x3F) + 0x80)) else if x <= 0xFFFF then f3 - (fromIntegral (x `shiftR` 12) + 0xE0) - (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80) - (fromIntegral (x .&. 0x3F) + 0x80) + (fromIntegral (x `shiftR` 12) + 0xE0) + (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80) + (fromIntegral (x .&. 0x3F) + 0x80) else f4 - (fromIntegral (x `shiftR` 18) + 0xF0) - (fromIntegral ((x `shiftR` 12) .&. 0x3F) + 0x80) - (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80) - (fromIntegral (x .&. 0x3F) + 0x80) + (fromIntegral (x `shiftR` 18) + 0xF0) + (fromIntegral ((x `shiftR` 12) .&. 0x3F) + 0x80) + (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80) + (fromIntegral (x .&. 0x3F) + 0x80) diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,30 +1,26 @@ module Main where -import Prelude +import qualified ByteString.StrictBuilder as B +import qualified Data.ByteString as A import Test.QuickCheck.Instances import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck -import qualified Data.ByteString as A -import qualified ByteString.StrictBuilder as B - +import Prelude main = defaultMain $ - testGroup "All tests" $ - [ - testProperty "Packing a list of bytes is isomorphic to appending a list of builders" $ - \byteList -> - A.pack byteList === - B.builderBytes (foldMap B.word8 byteList) - , - testProperty "Concatting a list of bytestrings is isomorphic to fold-mapping with builders" $ - \bytesList -> - mconcat bytesList === - B.builderBytes (foldMap B.bytes bytesList) - , - testProperty "Concatting a list of bytestrings is isomorphic to concatting a list of builders" $ - \bytesList -> - mconcat bytesList === - B.builderBytes (mconcat (map B.bytes bytesList)) - ] + testGroup "All tests" $ + [ testProperty "Packing a list of bytes is isomorphic to appending a list of builders" $ + \byteList -> + A.pack byteList + === B.builderBytes (foldMap B.word8 byteList), + testProperty "Concatting a list of bytestrings is isomorphic to fold-mapping with builders" $ + \bytesList -> + mconcat bytesList + === B.builderBytes (foldMap B.bytes bytesList), + testProperty "Concatting a list of bytestrings is isomorphic to concatting a list of builders" $ + \bytesList -> + mconcat bytesList + === B.builderBytes (mconcat (map B.bytes bytesList)) + ]