bytebuild 0.3.7.0 → 0.3.8.0

raw patch · 7 files changed

+79/−99 lines, 7 filesdep ~byteslicePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: byteslice

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• bytebuild.cabal +3/−2
• cbits/bytebuild_custom.c +11/−0
• src/Data/Bytes/Builder.hs +4/−2
• src/Data/Bytes/Builder/Bounded.hs +31/−93
• src/Data/Bytes/Builder/Unsafe.hs +1/−1
• test/Main.hs +23/−1

@@ -5,6 +5,12 @@ `small-bytearray-builder` is now just a compatibility shim to ease the migration process. +## 0.3.8.0 -- 2020-??-??++* Fix `doubleDec`, which was encoding small numbers incorrectly.+* Add `runByteString` for producing `ByteString` from bounded builders.+* Correct the required length calculation for json string encoding.+ ## 0.3.7.0 -- 2020-11-06  * Fix build error in test suite.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytebuild-version: 0.3.7.0+version: 0.3.8.0 synopsis: Serialize to a small byte arrays description:   This is similar to the builder facilities provided by@@ -44,7 +44,7 @@     Data.Bytes.Chunks   build-depends:     , base >=4.12.0.0 && <5-    , byteslice >=0.2 && <0.3+    , byteslice >=0.2.5 && <0.3     , bytestring >=0.10.8.2 && <0.11     , integer-logarithms >=1.0.3 && <1.1     , natural-arithmetic >=0.1 && <0.2@@ -60,6 +60,7 @@   ghc-options: -Wall -O2   hs-source-dirs: src   default-language: Haskell2010+  c-sources: cbits/bytebuild_custom.c  test-suite test   default-language: Haskell2010

@@ -0,0 +1,11 @@+#include "Rts.h"+#include <stdint.h>+#include <string.h>++HsInt bytebuild_paste_double(char *s0, HsInt off, double n) {+    char* start = s0 + off;+    memset(start,0,32);+    sprintf(s0 + off,"%.14g", n);+    size_t r = strlen(start);+    return (HsInt)r;+}

@@ -345,7 +345,7 @@             (# sX, bufX, 0#, 4080#, Mutable buf0 off0 cs0 #)         _ -> (# s0, buf0, off0, len0, cs0 #)    in case f buf1 off1 s1 of-        (# s2, off2 #) -> (# s2, buf1, off2, len1 -# (off2 -# off1), cs1 #)+        (# s2, _ #) -> (# s2, buf1, off1 +# 1#, len1 -# 1#, cs1 #)  -- | Create a builder from an unsliced byte sequence. Implemented with 'bytes'. byteArray :: ByteArray -> Builder@@ -669,7 +669,9 @@   pure (doffRes + 1)   where   slen0 = I# slen0#-  reqLen = (2 * slen0) + 2+  -- We multiply by 6 because, in the worst case, everything might be in the+  -- unprintable ASCII range. The plus 2 is for the quotes on the ends.+  reqLen = (6 * slen0) + 2  -- | Constructor for 'Builder' that works on a function with lifted -- arguments instead of unlifted ones. This is just as unsafe as the

@@ -9,6 +9,7 @@ {-# language TypeApplications #-} {-# language TypeOperators #-} {-# language UnboxedTuples #-}+{-# language UnliftedFFITypes #-}  -- | The functions in this module are explict about the maximum number -- of bytes they require.@@ -17,6 +18,7 @@     Builder     -- * Execute   , run+  , runByteString   , pasteGrowST     -- * Combine   , empty@@ -103,9 +105,10 @@ import Arithmetic.Types (type (<=), type (:=:)) import Control.Monad.Primitive (primitive_) import Control.Monad.ST (ST)-import Control.Monad.ST.Run (runByteArrayST)+import Control.Monad.ST.Run (runByteArrayST,runIntByteArrayST) import Data.Bits import Data.Bytes.Builder.Bounded.Unsafe (Builder(..))+import Data.ByteString (ByteString) import Data.Char (ord) import Data.Primitive (MutableByteArray(..),ByteArray,writeByteArray) import Data.Primitive (readByteArray,newByteArray,unsafeFreezeByteArray)@@ -113,13 +116,16 @@ import Data.WideWord (Word128(Word128),Word256(Word256)) import GHC.Exts import GHC.Int (Int64(I64#),Int32(I32#),Int16(I16#),Int8(I8#))+import GHC.IO (unsafeIOToST) import GHC.ST (ST(ST)) import GHC.TypeLits (type (+)) import GHC.Word (Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#))+import Data.Bytes.Types (Bytes(Bytes))  import qualified Arithmetic.Lte as Lte import qualified Arithmetic.Nat as Nat import qualified Arithmetic.Types as Arithmetic+import qualified Data.Bytes as Bytes import qualified Data.Bytes.Builder.Bounded.Unsafe as Unsafe import qualified Data.Primitive as PM @@ -137,6 +143,22 @@   shrinkMutableByteArray arr len   unsafeFreezeByteArray arr +-- | Variant of 'run' that puts the result in a pinned buffer and+-- packs it up in a 'ByteString'.+runByteString ::+     Arithmetic.Nat n+  -> Builder n -- ^ Builder+  -> ByteString+{-# inline runByteString #-}+runByteString n b =+  let (finalLen,r) = runIntByteArrayST $ do+        arr <- PM.newPinnedByteArray (Nat.demote n)+        len <- Unsafe.pasteST b arr 0+        shrinkMutableByteArray arr len+        arr' <- unsafeFreezeByteArray arr+        pure (len,arr')+   in Bytes.pinnedToByteString (Bytes r 0 finalLen)+ -- | Paste the builder into the byte array starting at offset zero. -- This reallocates the byte array if it cannot accomodate the builder, -- growing it by the minimum amount necessary.@@ -1032,100 +1054,12 @@ -- inaccurate. This is very visible when encoding a number like 2.25, which -- is perfectly represented as an IEEE 754 floating point number but is goofed -- up by this function.--- If you modify this function, please take a took at the resulting core.--- It currently performs no boxing at all, and it would be nice to keep--- it that way. doubleDec# :: forall s.   Double# -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)-{-# noinline doubleDec# #-}-doubleDec# d# marr# off# s0 = unIntST s0 $ do-  let marr = MutableByteArray marr#-  let d0 = D# d#-  let off0 = I# off#-  if d0 == 0-    then do-      writeByteArray marr off0 (c2w '0')-      pure (off0 + 1)-    else do-      let neg = d0 < 0-      off1 <- if neg-        then do-          writeByteArray marr off0 (c2w '-')-          pure (off0 + 1)-        else pure off0-      let d1 = abs d0-      let mag0 = floor (logBase10 d1) :: Int-      let useExp = (mag0 >= 14 || (neg && mag0 >= 9) || mag0 <= (-9))-      -- This straightforward adaptation of the C code is awkward-      -- in Haskell. Binding the triple where mag1 might not even-      -- get used is strange.-      let !(!d2,!mag1,!mag0A) = if useExp-            then-              let mag0' = if mag0 < 0 then mag0 - 1 else mag0-               in (d1 / (10.0 ** fromIntegral @Int @Double mag0'), mag0', 0)-            else (d1,0,mag0)-      let mag0B = if mag0A < 1 then 0 else mag0A-      let goNum :: Double -> Int -> Int -> ST s Int-          goNum !dA0 !mag !offA0 = if (dA0 > doublePrecision || mag >= 0)-            then do-              let weight = 10.0 ** (fromIntegral @Int @Double mag)-              -- We should actually check weight with isinf here,-              -- but we do not.-              (dA1,offA1) <- if weight > 0-                then do-                  -- TODO: use a better floor function-                  let digit = ((floor :: Double -> Int) (dA0 / weight))-                  let discard = fromIntegral @Int @Double digit * weight-                  writeByteArray marr offA0-                    (fromIntegral @Int @Word8 (digit + ord '0'))-                  pure (dA0 - discard,offA0 + 1)-                else pure (dA0,offA0)-              offA2 <- if mag == 0 && dA1 > 0-                then do-                  writeByteArray marr offA1 (c2w '.')-                  pure (offA1 + 1)-                else pure offA1-              goNum dA1 (mag - 1) offA2-            else pure offA0-      !off2 <- goNum d2 mag0B off1-      off3 <- if useExp-        then do-          writeByteArray marr off2 (c2w 'e')-          !mag2 <- if mag1 > 0-            then do-              writeByteArray marr (off2 + 1) (c2w '+')-              pure mag1-            else do-              writeByteArray marr (off2 + 1) (c2w '-')-              pure (-mag1)-          let goMag !mag !off = if mag > 0-                then do-                  let (q,r) = quotRem mag 10-                  writeByteArray marr off (fromIntegral @Int @Word8 (ord '0' + r))-                  goMag q (off + 1)-                else pure off-          !off3 <- goMag mag2 (off2 + 2)-          reverseBytes marr (off2 + 2) (off3 - 1)-          pure off3-        else pure off2-      pure off3--doublePrecision :: Double-doublePrecision = 0.00000000000001--unIntST :: State# s -> ST s Int -> (# State# s, Int# #)-{-# inline unIntST #-}-unIntST s0 (ST f) = case f s0 of-  (# s1, I# i #) -> (# s1, i #)---- This is slightly inaccurate. I think this can actually cause--- problems in some situations. The log10 function from C would--- be better. The inaccuracy here cause the logarithm to be slightly--- larger than it should be. There might actually be a simple way to--- fix this by just using recursion to compute it. We just floor the--- result anyway. Hmm...-logBase10 :: Double -> Double-logBase10 d = log d / 2.30258509299+doubleDec# d# marr# off# s0 =+  case unsafeIOToST (c_paste_double marr# off# d#) of+    ST f -> case f s0 of+      (# s1, I# r #) -> (# s1, r #)  -- Based on C code from https://stackoverflow.com/a/5558614 -- For numbers less than 1073741829, this gives a correct answer.@@ -1134,3 +1068,7 @@  unsafeWordToWord8 :: Word -> Word8 unsafeWordToWord8 (W# w) = W8# w++foreign import ccall unsafe "bytebuild_paste_double" c_paste_double ::+  MutableByteArray# s -> Int# -> Double# -> IO Int+

@@ -209,7 +209,7 @@     s1 -> copyReverseCommits# marr off cs s1  -- | Create a builder from a cons-list of 'Char'. These--- are be UTF-8 encoded.+-- must be UTF-8 encoded. stringUtf8 :: String -> Builder {-# inline stringUtf8 #-} stringUtf8 cs = Builder (goString cs)

@@ -1,4 +1,5 @@ {-# language BangPatterns #-}+{-# language NumericUnderscores #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} {-# language OverloadedStrings #-}@@ -128,7 +129,7 @@     , THU.testCase "doubleDec-D" $         pack ("-42") @=? runConcat 1 (doubleDec (-42))     , THU.testCase "doubleDec-E" $-        pack ("-8.88888888888888e+14") @=? runConcat 1 (doubleDec (-888888888888888.8888888))+        AsciiByteArray (pack ("-8.8888888888889e+14")) @=? AsciiByteArray (runConcat 1 (doubleDec (-888888888888888.8888888)))     , THU.testCase "doubleDec-F" $         pack ("42") @=? runConcat 1 (doubleDec 42)     , THU.testCase "doubleDec-G" $@@ -141,6 +142,18 @@         pack ("999999999") @=? runConcat 1 (doubleDec 999999999)     , THU.testCase "doubleDec-K" $         pack ("-99999999") @=? runConcat 1 (doubleDec (-99999999))+    , THU.testCase "doubleDec-L" $+        AsciiByteArray (pack ("6.6666666666667e-12")) @=? AsciiByteArray (runConcat 1 (doubleDec (2 / 300_000_000_000)))+    , THU.testCase "doubleDec-M" $+        AsciiByteArray (pack ("6.6666666666667e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 6.666666666666667e-10))+    , THU.testCase "doubleDec-N" $+        AsciiByteArray (pack ("5e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 5.0e-10))+    , THU.testCase "doubleDec-O" $+        AsciiByteArray (pack ("1.6666666666667e-10")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.6666666666666669e-10))+    , THU.testCase "doubleDec-P" $+        AsciiByteArray (pack ("1e-09")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.0e-9))+    , THU.testCase "doubleDec-Q" $+        AsciiByteArray (pack ("1e-08")) @=? AsciiByteArray (runConcat 1 (doubleDec 1.0e-8))     , THU.testCase "shortTextJsonString-A" $         pack ("\"hello\"") @=? runConcat 1 (shortTextJsonString "hello")     , THU.testCase "shortTextJsonString-B" $@@ -315,6 +328,15 @@  c2w :: Char -> Word8 c2w = fromIntegral . ord++-- Just a wrapper with a show instance that displays as ascii when possible.+newtype AsciiByteArray = AsciiByteArray ByteArray+  deriving (Eq)++instance Show AsciiByteArray where+  show (AsciiByteArray b) = if Bytes.all (\w -> w >= 32 && w < 127) (Bytes.fromByteArray b)+    then Bytes.toLatinString (Bytes.fromByteArray b)+    else show (show b)  instance Arbitrary Word128 where   arbitrary = liftA2 Word128 TQC.arbitrary TQC.arbitrary