Initial commit. The library includes a simple Builder, a Semigroup instance, primitives for running the builder, and a function for decimal-encoding a 64-bit word. There is also a test suite to confirm that it works.

.gitignore

@@ -0,0 +1,27 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+stack.yaml
+*.swm
+*.swo
+*.swp
+test_results/**

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for small-bytearray-builder
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2019, Andrew Martin
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Andrew Martin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

small-bytearray-builder.cabal

@@ -0,0 +1,40 @@
+cabal-version:       2.2
+name: small-bytearray-builder
+version: 0.1.0.0
+-- synopsis:
+-- description:
+homepage: https://github.com/andrewthad/small-bytearray-builder
+-- bug-reports:
+license: BSD-3-Clause
+license-file: LICENSE
+author: Andrew Martin
+maintainer: andrew.thaddeus@gmail.com
+copyright: 2019 Andrew Martin
+category: Data
+extra-source-files: CHANGELOG.md
+
+library
+  exposed-modules:
+    Data.ByteArray.Builder.Small
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      base >=4.12.0.0 && <5
+    , primitive >=0.7 && <0.8
+    , byteslice >=0.1 && <0.2
+  ghc-options: -Wall -O2 -ddump-to-file -ddump-simpl
+  hs-source-dirs: src
+  default-language: Haskell2010
+
+test-suite test
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  build-depends:
+      base >=4.12.0.0 && <5
+    , small-bytearray-builder
+    , QuickCheck >=2.13.1 && <2.14
+    , tasty-quickcheck >=0.10.1 && <0.11
+    , tasty >=1.2.3 && <1.3
+    , primitive

src/Data/ByteArray/Builder/Small.hs

@@ -0,0 +1,115 @@
+{-# language ScopedTypeVariables #-}
+{-# language BangPatterns #-}
+{-# language MagicHash #-}
+{-# language UnboxedTuples #-}
+{-# language RankNTypes #-}
+{-# language LambdaCase #-}
+
+module Data.ByteArray.Builder.Small
+  ( -- * Unsafe Primitives
+    Builder(..)
+  , construct
+    -- * Evaluation
+  , run
+  , pasteST
+    -- * Numbers
+  , word64Dec
+  ) where
+
+import Control.Monad.Primitive
+import Data.Char (ord)
+import Data.Primitive
+import GHC.Exts
+import GHC.Word
+import Data.Bytes.Types
+import GHC.ST
+
+-- | An unmaterialized sequence of bytes that may be pasted
+-- into a mutable byte array.
+newtype Builder = Builder
+  (forall s. MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #))
+
+instance Semigroup Builder where
+  {-# inline (<>) #-}
+  Builder f <> Builder g = Builder $ \arr off0 len0 s0 -> case f arr off0 len0 s0 of
+    (# s1, r #) -> case r /=# (-1#) of
+      1# -> g arr r (len0 +# (off0 -# r)) s1
+      _ -> (# s1, (-1#) #)
+
+-- | Run a builder. An accurate size hint is important for good performance.
+run ::
+     Int -- ^ Hint for upper bound on size
+  -> Builder -- ^ Builder
+  -> ByteArray
+run hint b = runST $ do
+  let go !n = do
+        arr <- newByteArray n
+        pasteST b (MutableBytes arr 0 n) >>= \case
+          Nothing -> go (n + 64)
+          Just len -> do
+            shrinkMutableByteArray arr len
+            unsafeFreezeByteArray arr
+  go hint
+
+pasteST :: Builder -> MutableBytes s -> ST s (Maybe Int)
+{-# inline pasteST #-}
+pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =
+  ST $ \s0 -> case f arr off len s0 of
+    (# s1, r #) -> if isTrue# (r /=# (-1#))
+      then (# s1, Just (I# r) #)
+      else (# s1, Nothing #)
+
+construct :: (forall s. MutableBytes s -> ST s (Maybe Int)) -> Builder
+construct f = Builder
+  $ \arr off len s0 ->
+    case unST (f (MutableBytes (MutableByteArray arr) (I# off) (I# len))) s0 of
+      (# s1, m #) -> case m of
+        Nothing -> (# s1, (-1#) #)
+        Just (I# n) -> (# s1, n #)
+
+word64Dec :: Word64 -> Builder
+word64Dec (W64# w) = word64Dec# w
+
+word64Dec# :: Word# -> Builder
+{-# noinline word64Dec# #-}
+word64Dec# w# = construct $ \(MutableBytes arr off0 len) -> if len >= 19
+  then if w /= 0
+    then do
+      let go off x = if x > 0
+            then do
+              let (y,z) = quotRem x 10
+              writeByteArray arr off (fromIntegral (z + 0x30) :: Word8)
+              go (off + 1) y
+            else do
+              reverseBytes arr off0 (off - 1)
+              pure (Just off)
+      go off0 w
+    else do
+      writeByteArray arr off0 (c2w '0')
+      pure (Just (off0 + 1))
+  else pure Nothing
+  where
+  w = W64# w#
+
+reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
+{-# inline reverseBytes #-}
+reverseBytes arr begin end = go begin end where
+  go ixA ixB = if ixA < ixB
+    then do
+      a :: Word8 <- readByteArray arr ixA
+      b :: Word8 <- readByteArray arr ixB
+      writeByteArray arr ixA b
+      writeByteArray arr ixB a
+      go (ixA + 1) (ixB - 1)
+    else pure ()
+
+c2w :: Char -> Word8
+c2w = fromIntegral . ord
+
+unST :: ST s a -> State# s -> (# State# s, a #)
+unST (ST f) = f
+
+shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()
+shrinkMutableByteArray (MutableByteArray arr) (I# sz) =
+  primitive_ (shrinkMutableByteArray# arr sz)
+

test/Main.hs

@@ -0,0 +1,28 @@
+{-# language TypeApplications #-}
+
+import Data.ByteArray.Builder.Small
+import Data.Word
+import Data.Char (ord)
+import Data.Primitive (ByteArray)
+import Test.Tasty (defaultMain,testGroup,TestTree)
+import Test.QuickCheck ((===))
+import qualified Test.Tasty.QuickCheck as TQC
+import qualified Test.QuickCheck as QC
+import qualified GHC.Exts as Exts
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests"
+  [ TQC.testProperty "word64Dec" $ \w ->
+      run 1 (word64Dec w) === pack (show w)
+  , TQC.testProperty "word64Dec-x3" $ \x y z ->
+      run 1 (word64Dec x <> word64Dec y <> word64Dec z)
+      ===
+      pack (show x ++ show y ++ show z)
+  ]
+
+pack :: String -> ByteArray
+pack = Exts.fromList . map (fromIntegral @Int @Word8 . ord)
+