cborg 0.2.4.0 → 0.2.5.0
raw patch · 6 files changed
+118/−41 lines, 6 filesdep ~basedep ~base16-bytestringdep ~base64-bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, base16-bytestring, base64-bytestring, bytestring, ghc-prim, semigroups, tasty
API changes (from Hackage documentation)
Files
- ChangeLog.md +1/−5
- cborg.cabal +16/−12
- src/Codec/CBOR/FlatTerm.hs +1/−1
- src/Codec/CBOR/Read.hs +5/−0
- src/Codec/CBOR/Write.hs +94/−22
- tests/Tests/Reference/TestVectors.hs +1/−1
ChangeLog.md view
@@ -1,10 +1,6 @@ # Revision history for cborg -## 0.2.4.0 -- 2020-07-05--* Performance improvements--## 0.2.3.0 -- 2020-05-10+## 0.2.3.1 -- 2020-05-10 * Bounds updates for GHC 8.10
cborg.cabal view
@@ -1,5 +1,5 @@ name: cborg-version: 0.2.4.0+version: 0.2.5.0 synopsis: Concise Binary Object Representation (CBOR) license: BSD3 license-file: LICENSE.txt@@ -13,7 +13,7 @@ build-type: Simple cabal-version: >= 1.10 tested-with:- GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1+ GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1, GHC == 9.0.1 extra-source-files: ChangeLog.md@@ -83,11 +83,11 @@ build-depends: array >= 0.4 && < 0.6,- base >= 4.7 && < 4.15,- bytestring >= 0.10.4 && < 0.11,+ base >= 4.7 && < 4.16,+ bytestring >= 0.10.4 && < 0.12, containers >= 0.5 && < 0.7, deepseq >= 1.0 && < 1.5,- ghc-prim >= 0.3.1.0 && < 0.7,+ ghc-prim >= 0.3.1.0 && < 0.8, half >= 0.2.2.3 && < 0.4, primitive >= 0.5 && < 0.8, text >= 1.1 && < 1.3@@ -100,8 +100,12 @@ if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances else- -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8- build-depends: fail == 4.9.*, semigroups >=0.18 && <0.20+ build-depends:+ -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8+ fail == 4.9.*,+ semigroups >= 0.18 && < 0.20,+ -- the `PS` pattern synonym in bytestring 0.11 is unavailable with GHC < 8.0+ bytestring < 0.11 test-suite tests type: exitcode-stdio-1.0@@ -134,20 +138,20 @@ build-depends: array >= 0.4 && < 0.6,- base >= 4.7 && < 4.15,+ base >= 4.7 && < 4.16, base-orphans,- bytestring >= 0.10.4 && < 0.11,+ bytestring >= 0.10.4 && < 0.12, text >= 1.1 && < 1.3, cborg, aeson >= 0.7 && < 1.6,- base64-bytestring >= 1.0 && < 1.2,- base16-bytestring >= 0.1 && < 0.2,+ base64-bytestring >= 1.0 && < 1.3,+ base16-bytestring >= 1.0 && < 1.1, deepseq >= 1.0 && < 1.5, half >= 0.2.2.3 && < 0.4, QuickCheck >= 2.9 && < 2.15, random, scientific >= 0.3 && < 0.4,- tasty >= 0.11 && < 1.4,+ tasty >= 0.11 && < 1.5, tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.11, vector >= 0.10 && < 0.13
src/Codec/CBOR/FlatTerm.hs view
@@ -250,7 +250,7 @@ TypeTag -> do !x <- decodeTag return $! TkTag (fromIntegral x)- TypeTag64 -> do !x <- decodeTag+ TypeTag64 -> do !x <- decodeTag64 return $! TkTag (fromIntegral x) TypeBool -> do !x <- decodeBool
src/Codec/CBOR/Read.hs view
@@ -9,9 +9,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +#if __GLASGOW_HASKELL__ < 900 -- Bump up from the default 1.5, otherwise our decoder fast path is no good. -- We went over the threshold when we switched to using ST.+--+-- However, this flag is not supported on GHC 9.0 and later and eye-balling the+-- Core suggests that the new inlining heuristics don't require it. {-# OPTIONS_GHC -funfolding-keeness-factor=2.0 #-}+#endif -- | -- Module : Codec.CBOR.Read
src/Codec/CBOR/Write.hs view
@@ -4,7 +4,17 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternSynonyms #-} +#include "cbor.h"++#if defined(OPTIMIZE_GMP)+#if __GLASGOW_HASKELL__ >= 900+#define HAVE_GHC_BIGNUM 1+{-# LANGUAGE UnboxedSums #-}+#endif+#endif+ -- | -- Module : Codec.CBOR.Write -- Copyright : (c) Duncan Coutts 2015-2017@@ -22,8 +32,6 @@ , toStrictByteString -- :: Encoding -> S.ByteString ) where -#include "cbor.h"- import Data.Bits import Data.Int @@ -44,14 +52,22 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T -#if defined(OPTIMIZE_GMP) import Control.Exception.Base (assert) import GHC.Exts+import GHC.IO (IO(IO))+#if defined(HAVE_GHC_BIGNUM)+import qualified GHC.Num.Integer+import qualified GHC.Num.BigNat as Gmp+import qualified GHC.Num.BigNat+import GHC.Num.BigNat (BigNat)+#else import qualified GHC.Integer.GMP.Internals as Gmp+import GHC.Integer.GMP.Internals (BigNat)+#endif+ #if __GLASGOW_HASKELL__ < 710 import GHC.Word #endif-#endif import qualified Codec.CBOR.ByteArray.Sliced as BAS import Codec.CBOR.Encoding@@ -129,9 +145,10 @@ -- This code is specialized for GMP implementation of Integer. By -- looking directly at the constructors we can avoid some checks. -- S# hold an Int, so we can just use intMP.- TkInteger (Gmp.S# i) vs' -> PI.runB intMP (I# i) op >>= go vs'- -- Jp# is guaranteed to be > 0.- TkInteger integer@(Gmp.Jp# bigNat) vs'+ TkInteger (SmallInt i) vs' ->+ PI.runB intMP (I# i) op >>= go vs'+ -- PosBigInt is guaranteed to be > 0.+ TkInteger integer@(PosBigInt bigNat) vs' | integer <= fromIntegral (maxBound :: Word64) -> PI.runB word64MP (fromIntegral integer) op >>= go vs' | otherwise ->@@ -139,7 +156,7 @@ in BI.runBuilderWith (bigNatMP bigNat) (buildStep vs' k) buffer -- Jn# is guaranteed to be < 0.- TkInteger integer@(Gmp.Jn# bigNat) vs'+ TkInteger integer@(NegBigInt bigNat) vs' | integer >= -1 - fromIntegral (maxBound :: Word64) -> PI.runB negInt64MP (fromIntegral (-1 - integer)) op >>= go vs' | otherwise ->@@ -181,7 +198,6 @@ bound :: Int bound = 9 - header :: P.BoundedPrim Word8 header = P.liftFixedToBounded P.word8 @@ -579,31 +595,87 @@ -- ---------------------------------------- -- -- Implementation optimized for integer-gmp -- -- ---------------------------------------- ---bigNatMP :: Gmp.BigNat -> B.Builder++-- Below is where we try to abstract over the differences between the legacy+-- integer-gmp interface and ghc-bignum, shipped in GHC >= 9.0.++-- | Write the limbs of a 'BigNat' to the given address in big-endian byte+-- ordering.+exportBigNatToAddr :: BigNat -> Addr# -> IO Word++#if defined(HAVE_GHC_BIGNUM)++pattern SmallInt n = GHC.Num.Integer.IS n+pattern PosBigInt n = GHC.Num.Integer.IP n+pattern NegBigInt n = GHC.Num.Integer.IN n++bigNatSizeInBytes :: GHC.Num.BigNat.BigNat -> Word+bigNatSizeInBytes bigNat =+ Gmp.bigNatSizeInBase 256 (GHC.Num.BigNat.unBigNat bigNat)++bigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder+bigNatMP n = P.primBounded header 0xc2 <> bigNatToBuilder (GHC.Num.BigNat.BN# n)++negBigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder+negBigNatMP n =+ -- If value `n` is stored in CBOR, it is interpreted as -1 - n. Since BigNat+ -- already represents n (note: it's unsigned), we simply decrement it to get+ -- the correct encoding.+ P.primBounded header 0xc3+ <> bigNatToBuilder (subtractOneBigNat (GHC.Num.BigNat.BN# n))+ where+ subtractOneBigNat (GHC.Num.BigNat.BN# nat) =+ case GHC.Num.BigNat.bigNatSubWord# nat 1## of+ (# | r #) -> GHC.Num.BigNat.BN# r+ (# (# #) | #) -> error "subtractOneBigNat: impossible"++exportBigNatToAddr (GHC.Num.BigNat.BN# b) addr = IO $ \s ->+ -- The last parameter (`1#`) makes the export function use big endian encoding.+ case GHC.Num.BigNat.bigNatToAddr# b addr 1# s of+ (# s', w #) -> (# s', W# w #)+#else++pattern SmallInt n = Gmp.S# n+pattern PosBigInt n = Gmp.Jp# n+pattern NegBigInt n = Gmp.Jn# n++bigNatSizeInBytes :: BigNat -> Word+bigNatSizeInBytes bigNat = W# (Gmp.sizeInBaseBigNat bigNat 256#)++bigNatMP :: BigNat -> B.Builder bigNatMP n = P.primBounded header 0xc2 <> bigNatToBuilder n -negBigNatMP :: Gmp.BigNat -> B.Builder+negBigNatMP :: BigNat -> B.Builder negBigNatMP n = -- If value `n` is stored in CBOR, it is interpreted as -1 - n. Since BigNat -- already represents n (note: it's unsigned), we simply decrement it to get -- the correct encoding. P.primBounded header 0xc3- <> bigNatToBuilder (Gmp.minusBigNatWord n (int2Word# 1#))+ <> bigNatToBuilder (subtractOneBigNat n)+ where+ subtractOneBigNat n = Gmp.minusBigNatWord n (int2Word# 1#) -bigNatToBuilder :: Gmp.BigNat -> B.Builder+exportBigNatToAddr bigNat addr# =+ -- The last parameter (`1#`) makes the export function use big endian encoding.+ Gmp.exportBigNatToAddr bigNat addr# 1#+#endif++bigNatToBuilder :: BigNat -> B.Builder bigNatToBuilder = bigNatBuilder where- bigNatBuilder :: Gmp.BigNat -> B.Builder+ bigNatBuilder :: BigNat -> B.Builder bigNatBuilder bigNat =- let sizeW# = Gmp.sizeInBaseBigNat bigNat 256#- bounded = PI.boudedPrim (I# (word2Int# sizeW#)) (dumpBigNat sizeW#)- in P.primBounded bytesLenMP (W# sizeW#) <> P.primBounded bounded bigNat+ let sizeW = bigNatSizeInBytes bigNat+#if MIN_VERSION_bytestring(0,10,12)+ bounded = PI.boundedPrim (fromIntegral sizeW) (dumpBigNat sizeW)+#else+ bounded = PI.boudedPrim (fromIntegral sizeW) (dumpBigNat sizeW)+#endif+ in P.primBounded bytesLenMP sizeW <> P.primBounded bounded bigNat - dumpBigNat :: Word# -> Gmp.BigNat -> Ptr a -> IO (Ptr a)- dumpBigNat sizeW# bigNat ptr@(Ptr addr#) = do- -- The last parameter (`1#`) makes the export function use big endian- -- encoding.- (W# written#) <- Gmp.exportBigNatToAddr bigNat addr# 1#+ dumpBigNat :: Word -> BigNat -> Ptr a -> IO (Ptr a)+ dumpBigNat (W# sizeW#) bigNat ptr@(Ptr addr#) = do+ (W# written#) <- exportBigNatToAddr bigNat addr# let !newPtr = ptr `plusPtr` (I# (word2Int# written#)) sanity = isTrue# (sizeW# `eqWord#` written#) return $ assert sanity newPtr
tests/Tests/Reference/TestVectors.hs view
@@ -44,7 +44,7 @@ encoded <- either fail return $ Base64.decode encoded64 encoded16 <- T.encodeUtf8 <$> obj .: "hex"- let encoded' = fst (Base16.decode encoded16)+ let encoded' = Base16.decodeLenient encoded16 when (encoded /= encoded') $ fail "hex and cbor encoding mismatch in input" roundTrip <- obj .: "roundtrip"