summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNikitaVolkov <>2017-03-20 21:34:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-03-20 21:34:00 (GMT)
commitdca534dc93df7edd61549a5823b841ed97feffcd (patch)
treeb906a7724bc52b799f8ebacad5d068ea54be9fa3
version 0.4.20.4.2
-rw-r--r--LICENSE22
-rw-r--r--Setup.hs2
-rw-r--r--benchmarks/Main.hs29
-rw-r--r--bytestring-strict-builder.cabal104
-rw-r--r--library/ByteString/StrictBuilder.hs197
-rw-r--r--library/ByteString/StrictBuilder/Population.hs196
-rw-r--r--library/ByteString/StrictBuilder/Population/UncheckedShifting.hs96
-rw-r--r--library/ByteString/StrictBuilder/Prelude.hs9
-rw-r--r--library/ByteString/StrictBuilder/UTF8.hs49
-rw-r--r--tests/Main.hs30
10 files changed, 734 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..defe17a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2015, Nikita Volkov
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs
new file mode 100644
index 0000000..28d7549
--- /dev/null
+++ b/benchmarks/Main.hs
@@ -0,0 +1,29 @@
+module Main where
+
+import Prelude
+import Criterion.Main
+import ByteString.StrictBuilder
+
+
+main =
+ defaultMain [leftAppends, rightAppends]
+
+leftAppends :: Benchmark
+leftAppends =
+ bench "leftAppends" $ whnf action $! replicate 1000 $ bytes "abc"
+ where
+ action bytesList =
+ builderBytes builder
+ where
+ builder =
+ foldl' (<>) mempty bytesList
+
+rightAppends :: Benchmark
+rightAppends =
+ bench "rightAppends" $ whnf action $! replicate 1000 $ bytes "abc"
+ where
+ action bytesList =
+ builderBytes builder
+ where
+ builder =
+ foldr (<>) mempty bytesList
diff --git a/bytestring-strict-builder.cabal b/bytestring-strict-builder.cabal
new file mode 100644
index 0000000..135c24b
--- /dev/null
+++ b/bytestring-strict-builder.cabal
@@ -0,0 +1,104 @@
+name:
+ bytestring-strict-builder
+version:
+ 0.4.2
+category:
+ Text, ByteString, Builders, Serialization
+synopsis:
+ An efficient strict bytestring builder
+description:
+ According to
+ <https://github.com/nikita-volkov/bytestring-builders-benchmark the competition benchmarks>,
+ this library provides the fastest builder of strict bytestrings.
+ .
+ Practical benchmarks have proven it to be highly performant aswell.
+ The encoders from the \"postgresql-binary\" library have shown
+ a stable performance improvement by factors of up to 10 after the migration
+ from the standard builder to \"bytestring-strict-builder\".
+homepage:
+ https://github.com/nikita-volkov/bytestring-strict-builder
+bug-reports:
+ https://github.com/nikita-volkov/bytestring-strict-builder/issues
+author:
+ Nikita Volkov <nikita.y.volkov@mail.ru>
+maintainer:
+ Nikita Volkov <nikita.y.volkov@mail.ru>
+copyright:
+ (c) 2017, Nikita Volkov
+license:
+ MIT
+license-file:
+ LICENSE
+build-type:
+ Simple
+cabal-version:
+ >=1.10
+
+source-repository head
+ type:
+ git
+ location:
+ git://github.com/nikita-volkov/bytestring-strict-builder.git
+
+library
+ hs-source-dirs:
+ library
+ default-extensions:
+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples
+ default-language:
+ Haskell2010
+ exposed-modules:
+ ByteString.StrictBuilder
+ other-modules:
+ ByteString.StrictBuilder.Prelude
+ ByteString.StrictBuilder.Population
+ ByteString.StrictBuilder.Population.UncheckedShifting
+ ByteString.StrictBuilder.UTF8
+ build-depends:
+ semigroups >= 0.18 && < 0.19,
+ bytestring >= 0.10 && < 0.11,
+ base-prelude >= 1.2 && < 2,
+ base >= 4.6 && < 5
+
+test-suite tests
+ type:
+ exitcode-stdio-1.0
+ hs-source-dirs:
+ tests
+ main-is:
+ Main.hs
+ default-extensions:
+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples
+ default-language:
+ Haskell2010
+ build-depends:
+ bytestring-strict-builder,
+ -- testing:
+ tasty == 0.11.*,
+ tasty-quickcheck == 0.8.*,
+ tasty-smallcheck == 0.8.*,
+ tasty-hunit == 0.9.*,
+ quickcheck-instances >= 0.3.11 && < 0.4,
+ -- general:
+ rerebase == 1.*
+
+benchmark benchmarks
+ type:
+ exitcode-stdio-1.0
+ hs-source-dirs:
+ benchmarks
+ main-is:
+ Main.hs
+ ghc-options:
+ -O2
+ -threaded
+ "-with-rtsopts=-N"
+ -funbox-strict-fields
+ default-extensions:
+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples
+ default-language:
+ Haskell2010
+ build-depends:
+ bytestring-strict-builder,
+ criterion == 1.1.*,
+ rerebase == 1.*
diff --git a/library/ByteString/StrictBuilder.hs b/library/ByteString/StrictBuilder.hs
new file mode 100644
index 0000000..22af68e
--- /dev/null
+++ b/library/ByteString/StrictBuilder.hs
@@ -0,0 +1,197 @@
+module ByteString.StrictBuilder
+(
+ Builder,
+ builderBytes,
+ builderChunksBuilder,
+ builderLength,
+ 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 qualified Data.ByteString as B
+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
+
+
+data Builder =
+ Builder !Int !A.Population
+
+instance Monoid Builder where
+ {-# INLINE mempty #-}
+ mempty =
+ Builder 0 mempty
+ {-# INLINE mappend #-}
+ mappend (Builder leftSize leftPopulation) (Builder rightSize rightPopulation) =
+ Builder (leftSize + rightSize) (leftPopulation <> rightPopulation)
+
+instance Semigroup Builder
+
+instance IsString Builder where
+ fromString =
+ bytes . fromString
+
+
+-- *
+-------------------------
+
+{-|
+Efficiently constructs a strict bytestring.
+-}
+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.
+-}
+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.
+-}
+builderLength :: Builder -> Int
+builderLength (Builder size population) =
+ size
+
+
+-- * Primitives
+-------------------------
+
+{-# INLINE bytes #-}
+bytes :: ByteString -> Builder
+bytes bytes =
+ Builder (B.length bytes) (A.bytes bytes)
+
+{-# INLINE lazyBytes #-}
+lazyBytes :: F.ByteString -> Builder
+lazyBytes =
+ F.foldlChunks (\builder -> mappend builder . bytes) mempty
+
+{-# INLINE byte #-}
+byte :: Word8 -> Builder
+byte =
+ word8
+
+
+-- * Extras
+-------------------------
+
+{-# INLINABLE asciiIntegral #-}
+asciiIntegral :: Integral a => a -> Builder
+asciiIntegral =
+ \case
+ 0 ->
+ byte 48
+ x ->
+ bool ((<>) (byte 45)) id (x >= 0) $
+ loop mempty $
+ abs x
+ where
+ loop builder remainder =
+ case remainder of
+ 0 ->
+ builder
+ _ ->
+ case quotRem remainder 10 of
+ (quot, rem) ->
+ loop (byte (48 + fromIntegral rem) <> builder) quot
+
+{-# INLINE asciiChar #-}
+asciiChar :: Char -> Builder
+asciiChar =
+ byte . fromIntegral . ord
+
+{-# INLINE CONLIKE storable #-}
+storable :: Storable a => a -> Builder
+storable value =
+ Builder size (A.storable size value)
+ where
+ size =
+ sizeOf value
+
+{-# INLINE word8 #-}
+word8 :: Word8 -> Builder
+word8 =
+ Builder 1 . A.word8
+
+{-# INLINE word16BE #-}
+word16BE :: Word16 -> Builder
+word16BE =
+ Builder 2 . A.word16BE
+
+{-# INLINE word32BE #-}
+word32BE :: Word32 -> Builder
+word32BE =
+ Builder 4 . A.word32BE
+
+{-# INLINE word64BE #-}
+word64BE :: Word64 -> Builder
+word64BE =
+ Builder 8 . A.word64BE
+
+{-# INLINE int8 #-}
+int8 :: Int8 -> Builder
+int8 =
+ Builder 1 . A.int8
+
+{-# INLINE int16BE #-}
+int16BE :: Int16 -> Builder
+int16BE =
+ Builder 2 . A.int16BE
+
+{-# INLINE int32BE #-}
+int32BE :: Int32 -> Builder
+int32BE =
+ Builder 4 . A.int32BE
+
+{-# INLINE int64BE #-}
+int64BE :: Int64 -> Builder
+int64BE =
+ Builder 8 . A.int64BE
+
+{-# INLINE utf8Char #-}
+utf8Char :: Char -> Builder
+utf8Char x =
+ E.char x bytes_1 bytes_2 bytes_3 bytes_4
+
+{-# INLINE bytes_1 #-}
+bytes_1 :: Word8 -> Builder
+bytes_1 b1 =
+ Builder 1 (A.bytes_1 b1)
+
+{-# INLINE bytes_2 #-}
+bytes_2 :: Word8 -> Word8 -> Builder
+bytes_2 b1 b2 =
+ Builder 2 (A.bytes_2 b1 b2)
+
+{-# INLINE bytes_3 #-}
+bytes_3 :: Word8 -> Word8 -> Word8 -> Builder
+bytes_3 b1 b2 b3 =
+ Builder 3 (A.bytes_3 b1 b2 b3)
+
+{-# INLINE bytes_4 #-}
+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
new file mode 100644
index 0000000..4134009
--- /dev/null
+++ b/library/ByteString/StrictBuilder/Population.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE CPP #-}
+module ByteString.StrictBuilder.Population where
+
+import ByteString.StrictBuilder.Prelude
+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) }
+
+instance Monoid Population where
+ {-# INLINE mempty #-}
+ mempty =
+ Population return
+ {-# INLINE mappend #-}
+ mappend (Population leftPtrUpdate) (Population rightPtrUpdate) =
+ Population (leftPtrUpdate >=> rightPtrUpdate)
+
+instance Semigroup Population
+
+
+{-|
+Turns into the standard lazy bytestring builder.
+-}
+{-# INLINE populationChunksBuilder #-}
+populationChunksBuilder :: Population -> G.Builder
+populationChunksBuilder (Population ptrUpdate) =
+ G.builder stepUpdate
+ where
+ stepUpdate :: G.BuildStep a -> G.BuildStep a
+ stepUpdate nextStep (G.BufferRange beginningPtr afterPtr) =
+ do
+ newBeginningPtr <- ptrUpdate beginningPtr
+ nextStep $! G.BufferRange newBeginningPtr afterPtr
+
+{-# INLINE followParallelly #-}
+followParallelly :: Population -> Int -> Population -> Population
+followParallelly (Population followerPtrUpdate) followeeLength (Population followeePtrUpdate) =
+ Population ptrUpdate
+ where
+ ptrUpdate ptr =
+ do
+ lock <- newEmptyMVar
+ forkIO $ do
+ followeePtrUpdate ptr
+ putMVar lock ()
+ followerPtrUpdate (plusPtr ptr followeeLength) <* takeMVar lock
+
+-- |
+-- Write the given bytes into the pointer and
+-- return a pointer incremented by the amount of written bytes.
+{-# INLINE bytes #-}
+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
+
+{-# INLINE storable #-}
+storable :: Storable a => Int -> a -> Population
+storable size value =
+ Population (\ptr -> poke (castPtr ptr) value $> plusPtr ptr size)
+
+{-# INLINE word8 #-}
+word8 :: Word8 -> Population
+word8 value =
+ Population $ \ptr ->
+ poke ptr value $> plusPtr ptr 1
+
+{-# INLINE word16BE #-}
+word16BE :: Word16 -> Population
+#ifdef WORDS_BIGENDIAN
+word16BE =
+ storable 2
+#else
+word16BE value =
+ Population $ \ptr -> do
+ poke ptr (fromIntegral (D.shiftr_w16 value 8) :: Word8)
+ pokeByteOff ptr 1 (fromIntegral value :: Word8)
+ return (plusPtr ptr 2)
+#endif
+
+{-# INLINE word32BE #-}
+word32BE :: Word32 -> Population
+#ifdef WORDS_BIGENDIAN
+word32BE =
+ storable 4
+#else
+word32BE value =
+ Population $ \ptr -> do
+ poke ptr (fromIntegral (D.shiftr_w32 value 24) :: Word8)
+ pokeByteOff ptr 1 (fromIntegral (D.shiftr_w32 value 16) :: Word8)
+ pokeByteOff ptr 2 (fromIntegral (D.shiftr_w32 value 8) :: Word8)
+ pokeByteOff ptr 3 (fromIntegral value :: Word8)
+ return (plusPtr ptr 4)
+#endif
+
+{-# INLINE word64BE #-}
+word64BE :: Word64 -> Population
+#ifdef WORDS_BIGENDIAN
+word64BE =
+ storable 8
+#else
+#if WORD_SIZE_IN_BITS < 64
+--
+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
+-- Word32, and write that
+--
+word64BE value =
+ word32BE (fromIntegral (D.shiftr_w64 value 32)) <>
+ word32BE (fromIntegral value)
+#else
+word64BE value =
+ Population $ \ptr -> do
+ poke ptr (fromIntegral (D.shiftr_w64 value 56) :: Word8)
+ pokeByteOff ptr 1 (fromIntegral (D.shiftr_w64 value 48) :: Word8)
+ pokeByteOff ptr 2 (fromIntegral (D.shiftr_w64 value 40) :: Word8)
+ pokeByteOff ptr 3 (fromIntegral (D.shiftr_w64 value 32) :: Word8)
+ pokeByteOff ptr 4 (fromIntegral (D.shiftr_w64 value 24) :: Word8)
+ pokeByteOff ptr 5 (fromIntegral (D.shiftr_w64 value 16) :: Word8)
+ pokeByteOff ptr 6 (fromIntegral (D.shiftr_w64 value 8) :: Word8)
+ pokeByteOff ptr 7 (fromIntegral value :: Word8)
+ return (plusPtr ptr 8)
+#endif
+#endif
+
+{-# INLINE int8 #-}
+int8 :: Int8 -> Population
+int8 =
+ word8 . fromIntegral
+
+-- | Encoding 'Int16's in big endian format.
+{-# INLINE int16BE #-}
+int16BE :: Int16 -> Population
+int16BE =
+ word16BE . fromIntegral
+
+-- | Encoding 'Int32's in big endian format.
+{-# INLINE int32BE #-}
+int32BE :: Int32 -> Population
+int32BE =
+ word32BE . fromIntegral
+
+-- | Encoding 'Int64's in big endian format.
+{-# INLINE int64BE #-}
+int64BE :: Int64 -> Population
+int64BE =
+ word64BE . fromIntegral
+
+{-# INLINE bytes_1 #-}
+bytes_1 :: Word8 -> Population
+bytes_1 byte1 =
+ Population $ \ptr -> do
+ poke ptr byte1
+ return (plusPtr ptr 1)
+
+{-# INLINE bytes_2 #-}
+bytes_2 :: Word8 -> Word8 -> Population
+bytes_2 byte1 byte2 =
+ Population $ \ptr -> do
+ poke ptr byte1
+ pokeByteOff ptr 1 byte2
+ return (plusPtr ptr 2)
+
+{-# INLINE bytes_3 #-}
+bytes_3 :: Word8 -> Word8 -> Word8 -> Population
+bytes_3 byte1 byte2 byte3 =
+ Population $ \ptr -> do
+ poke ptr byte1
+ pokeByteOff ptr 1 byte2
+ pokeByteOff ptr 2 byte3
+ return (plusPtr ptr 3)
+
+{-# INLINE bytes_4 #-}
+bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Population
+bytes_4 byte1 byte2 byte3 byte4 =
+ Population $ \ptr -> do
+ poke ptr byte1
+ pokeByteOff ptr 1 byte2
+ pokeByteOff ptr 2 byte3
+ pokeByteOff ptr 3 byte4
+ return (plusPtr ptr 4)
+
+{-# INLINE utf8UnicodeCodePoint #-}
+utf8UnicodeCodePoint :: Int -> Population
+utf8UnicodeCodePoint x =
+ E.unicodeCodePoint x bytes_1 bytes_2 bytes_3 bytes_4
+
+{-# INLINE utf8Char #-}
+utf8Char :: Int -> Population
+utf8Char x =
+ E.unicodeCodePoint x bytes_1 bytes_2 bytes_3 bytes_4
diff --git a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
new file mode 100644
index 0000000..69ba0ff
--- /dev/null
+++ b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE CPP #-}
+-- |
+-- Copyright : (c) 2010 Simon Meier
+--
+-- Original serialization code from 'Data.Binary.Builder':
+-- (c) Lennart Kolmodin, Ross Patterson
+--
+-- License : BSD3-style
+--
+-- Utilty module defining unchecked shifts.
+--
+-- 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
+
+
+#if !defined(__HADDOCK__)
+import GHC.Base
+import GHC.Word (Word32(..),Word16(..),Word64(..))
+
+#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608
+import GHC.Word (uncheckedShiftRL64#)
+#endif
+#else
+import Data.Word
+#endif
+
+import Prelude
+import Foreign
+
+
+------------------------------------------------------------------------
+-- Unchecked shifts
+
+-- | Right-shift of a 'Word16'.
+{-# INLINE shiftr_w16 #-}
+shiftr_w16 :: Word16 -> Int -> Word16
+
+-- | Right-shift of a 'Word32'.
+{-# INLINE shiftr_w32 #-}
+shiftr_w32 :: Word32 -> Int -> Word32
+
+-- | Right-shift of a 'Word64'.
+{-# INLINE shiftr_w64 #-}
+shiftr_w64 :: Word64 -> Int -> Word64
+
+-- | Right-shift of a 'Word'.
+{-# INLINE shiftr_w #-}
+shiftr_w :: Word -> Int -> Word
+#if WORD_SIZE_IN_BITS < 64
+shiftr_w w s = fromIntegral $ (`shiftr_w32` s) $ fromIntegral w
+#else
+shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w
+#endif
+
+#if !defined(__HADDOCK__)
+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
+
+#if WORD_SIZE_IN_BITS < 64
+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
+#else
+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
+#endif
+
+#else
+shiftr_w16 = shiftR
+shiftr_w32 = shiftR
+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 =
+#if MIN_VERSION_base(4,7,0)
+ case finiteBitSize (undefined :: Word) of
+#else
+ case bitSize (undefined :: Word) of
+#endif
+ 32 -> f32
+ 64 -> f64
+ s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s
diff --git a/library/ByteString/StrictBuilder/Prelude.hs b/library/ByteString/StrictBuilder/Prelude.hs
new file mode 100644
index 0000000..7165351
--- /dev/null
+++ b/library/ByteString/StrictBuilder/Prelude.hs
@@ -0,0 +1,9 @@
+module ByteString.StrictBuilder.Prelude
+(
+ module Exports,
+)
+where
+
+import BasePrelude as Exports
+import Data.ByteString as Exports (ByteString)
+import Data.Semigroup as Exports hiding ((<>), Last(..), First(..))
diff --git a/library/ByteString/StrictBuilder/UTF8.hs b/library/ByteString/StrictBuilder/UTF8.hs
new file mode 100644
index 0000000..c1bb7f4
--- /dev/null
+++ b/library/ByteString/StrictBuilder/UTF8.hs
@@ -0,0 +1,49 @@
+{- |
+Utilities for the UTF-8 encoding.
+-}
+module ByteString.StrictBuilder.UTF8 where
+
+import ByteString.StrictBuilder.Prelude
+
+
+{-|
+Church encoding of a UTF8-encoded character.
+-}
+type UTF8Char =
+ forall a.
+ (Word8 -> a) ->
+ (Word8 -> Word8 -> a) ->
+ (Word8 -> Word8 -> Word8 -> a) ->
+ (Word8 -> Word8 -> Word8 -> Word8 -> a) ->
+ a
+
+{-# INLINE char #-}
+char :: Char -> UTF8Char
+char =
+ unicodeCodePoint . ord
+
+{-# INLINE unicodeCodePoint #-}
+unicodeCodePoint :: Int -> UTF8Char
+unicodeCodePoint x f1 f2 f3 f4 =
+ if x <= 0x7F
+ then
+ f1 (fromIntegral x)
+ else
+ if x <= 0x07FF
+ then
+ f2
+ (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)
+ else
+ f4
+ (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
new file mode 100644
index 0000000..d7de55d
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import Prelude
+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
+
+
+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))
+ ]