cborg 0.2.5.0 → 0.2.6.0
raw patch · 10 files changed
+330/−199 lines, 10 filesdep +ghc-bignumdep ~aesondep ~basedep ~integer-gmpPVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-bignum
Dependency ranges changed: aeson, base, integer-gmp, semigroups, text
API changes (from Hackage documentation)
+ Codec.CBOR.Magic: int64ToWord64 :: Int64 -> Word64
+ Codec.CBOR.Magic: intToWord :: Int -> Word
+ Codec.CBOR.Magic: intToWord64 :: Int -> Word64
Files
- ChangeLog.md +14/−0
- cborg.cabal +19/−10
- src/Codec/CBOR/Decoding.hs +60/−26
- src/Codec/CBOR/FlatTerm.hs +7/−0
- src/Codec/CBOR/Magic.hs +65/−7
- src/Codec/CBOR/Read.hs +125/−125
- src/Codec/CBOR/Write.hs +25/−10
- src/cbits/cbor.h +0/−18
- tests/Tests/Properties.hs +2/−1
- tests/Tests/Reference.hs +13/−2
ChangeLog.md view
@@ -1,5 +1,19 @@ # Revision history for cborg +## 0.2.6.0 -- 2021-10-31++* Support for GHC 9.2++* Support for `text-2.0` and zero-copy `Text` serialisation support++## 0.2.5.0 -- 2021-04-08++* Support for `ghc-bignum` and GHC 9.0++## 0.2.4.0 -- 2021-07-05++* Fix decoding on 32-bit systems (#244)+ ## 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.5.0+version: 0.2.6.0 synopsis: Concise Binary Object Representation (CBOR) license: BSD3 license-file: LICENSE.txt@@ -13,7 +13,13 @@ build-type: Simple cabal-version: >= 1.10 tested-with:- 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+ 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,19 +89,22 @@ build-depends: array >= 0.4 && < 0.6,- base >= 4.7 && < 4.16,+ base >= 4.8 && < 4.17, bytestring >= 0.10.4 && < 0.12, containers >= 0.5 && < 0.7, deepseq >= 1.0 && < 1.5,- ghc-prim >= 0.3.1.0 && < 0.8,+ ghc-prim >= 0.3.1.0 && < 0.9, half >= 0.2.2.3 && < 0.4, primitive >= 0.5 && < 0.8,- text >= 1.1 && < 1.3+ text >= 1.1 && < 1.3 || >= 2.0 && <2.1 if flag(optimize-gmp)- cpp-options: -DFLAG_OPTIMIZE_GMP- build-depends:- integer-gmp+ cpp-options: -DOPTIMIZE_GMP+ if impl(ghc >= 9.0)+ cpp-options: -DHAVE_GHC_BIGNUM+ build-depends: ghc-bignum >= 1.0 && < 2.0+ else+ build-depends: integer-gmp >= 1.0 && < 2.0 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances@@ -138,12 +147,12 @@ build-depends: array >= 0.4 && < 0.6,- base >= 4.7 && < 4.16,+ base >= 4.7 && < 4.17, base-orphans, bytestring >= 0.10.4 && < 0.12, text >= 1.1 && < 1.3, cborg,- aeson >= 0.7 && < 1.6,+ aeson >= 0.7 && < 2.1, base64-bytestring >= 1.0 && < 1.3, base16-bytestring >= 1.0 && < 1.1, deepseq >= 1.0 && < 1.5,
src/Codec/CBOR/Decoding.hs view
@@ -311,6 +311,40 @@ getDecodeAction (Decoder k) = k (\x -> return (Done x)) +-- Compatibility Shims+toInt8 :: Int# -> Int8+toInt16 :: Int# -> Int16+toInt32 :: Int# -> Int32+toInt64 :: Int# -> Int64+toWord8 :: Word# -> Word8+toWord16 :: Word# -> Word16+toWord32 :: Word# -> Word32+toWord64 :: Word# -> Word64+#if MIN_VERSION_ghc_prim(0,8,0)+toInt8 n = I8# (intToInt8# n)+toInt16 n = I16# (intToInt16# n)+toInt32 n = I32# (intToInt32# n)+toWord8 n = W8# (wordToWord8# n)+toWord16 n = W16# (wordToWord16# n)+toWord32 n = W32# (wordToWord32# n)+#if WORD_SIZE_IN_BITS == 64+toInt64 n = I64# n+toWord64 n = W64# n+#else+toInt64 n = I64# (intToInt64# n)+toWord64 n = W64# (wordToWord64# n)+#endif+#else+toInt8 n = I8# n+toInt16 n = I16# n+toInt32 n = I32# n+toInt64 n = I64# n+toWord8 n = W8# n+toWord16 n = W16# n+toWord32 n = W32# n+toWord64 n = W64# n+#endif+ -- $canonical -- -- <https://tools.ietf.org/html/rfc7049#section-3.9>@@ -358,21 +392,21 @@ -- -- @since 0.2.0.0 decodeWord8 :: Decoder s Word8-decodeWord8 = Decoder (\k -> return (ConsumeWord8 (\w# -> k (W8# w#))))+decodeWord8 = Decoder (\k -> return (ConsumeWord8 (\w# -> k (toWord8 w#)))) {-# INLINE decodeWord8 #-} -- | Decode a 'Word16'. -- -- @since 0.2.0.0 decodeWord16 :: Decoder s Word16-decodeWord16 = Decoder (\k -> return (ConsumeWord16 (\w# -> k (W16# w#))))+decodeWord16 = Decoder (\k -> return (ConsumeWord16 (\w# -> k (toWord16 w#)))) {-# INLINE decodeWord16 #-} -- | Decode a 'Word32'. -- -- @since 0.2.0.0 decodeWord32 :: Decoder s Word32-decodeWord32 = Decoder (\k -> return (ConsumeWord32 (\w# -> k (W32# w#))))+decodeWord32 = Decoder (\k -> return (ConsumeWord32 (\w# -> k (toWord32 w#)))) {-# INLINE decodeWord32 #-} -- | Decode a 'Word64'.@@ -382,9 +416,9 @@ {-# INLINE decodeWord64 #-} decodeWord64 = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeWord (\w# -> k (W64# w#))))+ Decoder (\k -> return (ConsumeWord (\w# -> k (toWord64 w#)))) #else- Decoder (\k -> return (ConsumeWord64 (\w64# -> k (W64# w64#))))+ Decoder (\k -> return (ConsumeWord64 (\w64# -> k (toWord64 w64#)))) #endif -- | Decode a negative 'Word'.@@ -401,9 +435,9 @@ {-# INLINE decodeNegWord64 #-} decodeNegWord64 = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeNegWord (\w# -> k (W64# w#))))+ Decoder (\k -> return (ConsumeNegWord (\w# -> k (toWord64 w#)))) #else- Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (W64# w64#))))+ Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (toWord64 w64#)))) #endif -- | Decode an 'Int'.@@ -417,21 +451,21 @@ -- -- @since 0.2.0.0 decodeInt8 :: Decoder s Int8-decodeInt8 = Decoder (\k -> return (ConsumeInt8 (\w# -> k (I8# w#))))+decodeInt8 = Decoder (\k -> return (ConsumeInt8 (\w# -> k (toInt8 w#)))) {-# INLINE decodeInt8 #-} -- | Decode an 'Int16'. -- -- @since 0.2.0.0 decodeInt16 :: Decoder s Int16-decodeInt16 = Decoder (\k -> return (ConsumeInt16 (\w# -> k (I16# w#))))+decodeInt16 = Decoder (\k -> return (ConsumeInt16 (\w# -> k (toInt16 w#)))) {-# INLINE decodeInt16 #-} -- | Decode an 'Int32'. -- -- @since 0.2.0.0 decodeInt32 :: Decoder s Int32-decodeInt32 = Decoder (\k -> return (ConsumeInt32 (\w# -> k (I32# w#))))+decodeInt32 = Decoder (\k -> return (ConsumeInt32 (\w# -> k (toInt32 w#)))) {-# INLINE decodeInt32 #-} -- | Decode an 'Int64'.@@ -441,9 +475,9 @@ {-# INLINE decodeInt64 #-} decodeInt64 = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeInt (\n# -> k (I64# n#))))+ Decoder (\k -> return (ConsumeInt (\n# -> k (toInt64 n#)))) #else- Decoder (\k -> return (ConsumeInt64 (\n64# -> k (I64# n64#))))+ Decoder (\k -> return (ConsumeInt64 (\n64# -> k (toInt64 n64#)))) #endif -- | Decode canonical representation of a 'Word'.@@ -457,21 +491,21 @@ -- -- @since 0.2.0.0 decodeWord8Canonical :: Decoder s Word8-decodeWord8Canonical = Decoder (\k -> return (ConsumeWord8Canonical (\w# -> k (W8# w#))))+decodeWord8Canonical = Decoder (\k -> return (ConsumeWord8Canonical (\w# -> k (toWord8 w#)))) {-# INLINE decodeWord8Canonical #-} -- | Decode canonical representation of a 'Word16'. -- -- @since 0.2.0.0 decodeWord16Canonical :: Decoder s Word16-decodeWord16Canonical = Decoder (\k -> return (ConsumeWord16Canonical (\w# -> k (W16# w#))))+decodeWord16Canonical = Decoder (\k -> return (ConsumeWord16Canonical (\w# -> k (toWord16 w#)))) {-# INLINE decodeWord16Canonical #-} -- | Decode canonical representation of a 'Word32'. -- -- @since 0.2.0.0 decodeWord32Canonical :: Decoder s Word32-decodeWord32Canonical = Decoder (\k -> return (ConsumeWord32Canonical (\w# -> k (W32# w#))))+decodeWord32Canonical = Decoder (\k -> return (ConsumeWord32Canonical (\w# -> k (toWord32 w#)))) {-# INLINE decodeWord32Canonical #-} -- | Decode canonical representation of a 'Word64'.@@ -481,9 +515,9 @@ {-# INLINE decodeWord64Canonical #-} decodeWord64Canonical = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (W64# w#))))+ Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (toWord64 w#)))) #else- Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (W64# w64#))))+ Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (toWord64 w64#)))) #endif -- | Decode canonical representation of a negative 'Word'.@@ -500,9 +534,9 @@ {-# INLINE decodeNegWord64Canonical #-} decodeNegWord64Canonical = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (W64# w#))))+ Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (toWord64 w#)))) #else- Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (W64# w64#))))+ Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (toWord64 w64#)))) #endif -- | Decode canonical representation of an 'Int'.@@ -516,21 +550,21 @@ -- -- @since 0.2.0.0 decodeInt8Canonical :: Decoder s Int8-decodeInt8Canonical = Decoder (\k -> return (ConsumeInt8Canonical (\w# -> k (I8# w#))))+decodeInt8Canonical = Decoder (\k -> return (ConsumeInt8Canonical (\w# -> k (toInt8 w#)))) {-# INLINE decodeInt8Canonical #-} -- | Decode canonical representation of an 'Int16'. -- -- @since 0.2.0.0 decodeInt16Canonical :: Decoder s Int16-decodeInt16Canonical = Decoder (\k -> return (ConsumeInt16Canonical (\w# -> k (I16# w#))))+decodeInt16Canonical = Decoder (\k -> return (ConsumeInt16Canonical (\w# -> k (toInt16 w#)))) {-# INLINE decodeInt16Canonical #-} -- | Decode canonical representation of an 'Int32'. -- -- @since 0.2.0.0 decodeInt32Canonical :: Decoder s Int32-decodeInt32Canonical = Decoder (\k -> return (ConsumeInt32Canonical (\w# -> k (I32# w#))))+decodeInt32Canonical = Decoder (\k -> return (ConsumeInt32Canonical (\w# -> k (toInt32 w#)))) {-# INLINE decodeInt32Canonical #-} -- | Decode canonical representation of an 'Int64'.@@ -540,9 +574,9 @@ {-# INLINE decodeInt64Canonical #-} decodeInt64Canonical = #if defined(ARCH_64bit)- Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (I64# n#))))+ Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (toInt64 n#)))) #else- Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (I64# n64#))))+ Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (toInt64 n64#)))) #endif -- | Decode an 'Integer'.@@ -759,7 +793,7 @@ -- -- @since 0.2.0.0 decodeSimple :: Decoder s Word8-decodeSimple = Decoder (\k -> return (ConsumeSimple (\w# -> k (W8# w#))))+decodeSimple = Decoder (\k -> return (ConsumeSimple (\w# -> k (toWord8 w#)))) {-# INLINE decodeSimple #-} -- | Decode canonical representation of an 'Integer'.@@ -795,7 +829,7 @@ -- -- @since 0.2.0.0 decodeSimpleCanonical :: Decoder s Word8-decodeSimpleCanonical = Decoder (\k -> return (ConsumeSimpleCanonical (\w# -> k (W8# w#))))+decodeSimpleCanonical = Decoder (\k -> return (ConsumeSimpleCanonical (\w# -> k (toWord8 w#)))) {-# INLINE decodeSimpleCanonical #-} --------------------------------------------------------------
src/Codec/CBOR/FlatTerm.hs view
@@ -55,6 +55,9 @@ import GHC.Word (Word64(W64#)) import GHC.Exts (Word64#, Int64#) #endif+#if MIN_VERSION_ghc_prim(0,8,0)+import GHC.Exts (word8ToWord#)+#endif import GHC.Word (Word(W#), Word8(W8#)) import GHC.Exts (Int(I#), Int#, Word#, Float#, Double#) import GHC.Float (Float(F#), Double(D#), float2Double)@@ -714,7 +717,11 @@ unW# (W# w#) = w# unW8# :: Word8 -> Word#+#if MIN_VERSION_ghc_prim(0,8,0)+unW8# (W8# w#) = word8ToWord# w#+#else unW8# (W8# w#) = w#+#endif unF# :: Float -> Float# unF# (F# f#) = f#
src/Codec/CBOR/Magic.hs view
@@ -48,12 +48,17 @@ -- int*ToInt conversions are missing because they are not needed. - , word8ToInt -- :: Int8 -> Int- , word16ToInt -- :: Int16 -> Int- , word32ToInt -- :: Int32 -> Int- , word64ToInt -- :: Int64 -> Int+ , word8ToInt -- :: Word8 -> Int+ , word16ToInt -- :: Word16 -> Int+ , word32ToInt -- :: Word32 -> Int+ , word64ToInt -- :: Word64 -> Int - , intToInt64 -- :: Int -> Int64+ , intToWord -- :: Int -> Word+ , intToInt64 -- :: Int -> Int64++ , intToWord64 -- :: Int -> Word64+ , int64ToWord64 -- :: Int64 -> Word64+ #if defined(ARCH_32bit) , word8ToInt64 -- :: Word8 -> Int64 , word16ToInt64 -- :: Word16 -> Int64@@ -93,8 +98,12 @@ import Foreign.Ptr #if defined(OPTIMIZE_GMP)+#if defined(HAVE_GHC_BIGNUM)+import qualified GHC.Num.Integer as BigNum+#else import qualified GHC.Integer.GMP.Internals as Gmp #endif+#endif import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -150,12 +159,17 @@ -- On x86 machines with GHC 7.10, we have byteswap primitives -- available to make this conversion very fast. +#if MIN_VERSION_ghc_prim(0,8,0)+grabWord16 (Ptr ip#) = W16# (wordToWord16# (byteSwap16# (word16ToWord# (indexWord16OffAddr# ip# 0#))))+grabWord32 (Ptr ip#) = W32# (wordToWord32# (byteSwap32# (word32ToWord# (indexWord32OffAddr# ip# 0#))))+#else grabWord16 (Ptr ip#) = W16# (narrow16Word# (byteSwap16# (indexWord16OffAddr# ip# 0#))) grabWord32 (Ptr ip#) = W32# (narrow32Word# (byteSwap32# (indexWord32OffAddr# ip# 0#)))+#endif #if defined(ARCH_64bit) grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#)) #else-grabWord64 (Ptr ip#) = W64# (byteSwap64# (indexWord64OffAddr# ip# 0#))+grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#))) #endif #elif defined(MEM_UNALIGNED_OPS) && \@@ -388,6 +402,31 @@ intToInt64 = fromIntegral {-# INLINE intToInt64 #-} +intToWord :: Int -> Word+intToWord = fromIntegral+{-# INLINE intToWord #-}++intToWord64 :: Int -> Word64+intToWord64 = fromIntegral+{-# INLINE intToWord64 #-}++int64ToWord64 :: Int64 -> Word64+int64ToWord64 = fromIntegral+{-# INLINE int64ToWord64 #-}++#if MIN_VERSION_ghc_prim(0,8,0)+word8ToWord (W8# w#) = W# (word8ToWord# w#)+word16ToWord (W16# w#) = W# (word16ToWord# w#)+word32ToWord (W32# w#) = W# (word32ToWord# w#)+#if defined(ARCH_64bit)+word64ToWord (W64# w#) = W# w#+#else+word64ToWord (W64# w64#) =+ case isTrue# (w64# `leWord64#` wordToWord64# 0xffffffff##) of+ True -> Just (W# (word64ToWord# w64#))+ False -> Nothing+#endif+#else word8ToWord (W8# w#) = W# w# word16ToWord (W16# w#) = W# w# word32ToWord (W32# w#) = W# w#@@ -399,12 +438,25 @@ True -> Just (W# (word64ToWord# w64#)) False -> Nothing #endif+#endif {-# INLINE word8ToWord #-} {-# INLINE word16ToWord #-} {-# INLINE word32ToWord #-} {-# INLINE word64ToWord #-} +#if MIN_VERSION_ghc_prim(0,8,0)+word8ToInt (W8# w#) = I# (word2Int# (word8ToWord# w#))+word16ToInt (W16# w#) = I# (word2Int# (word16ToWord# w#))+#if defined(ARCH_64bit)+word32ToInt (W32# w#) = I# (word2Int# (word32ToWord# w#))+#else+word32ToInt (W32# w#) =+ case isTrue# (w# `ltWord#` 0x80000000##) of+ True -> Just (I# (word2Int# (word32ToWord# w#)))+ False -> Nothing+#endif+#else word8ToInt (W8# w#) = I# (word2Int# w#) word16ToInt (W16# w#) = I# (word2Int# w#) @@ -416,6 +468,7 @@ True -> Just (I# (word2Int# w#)) False -> Nothing #endif+#endif #if defined(ARCH_64bit) word64ToInt (W64# w#) =@@ -477,7 +530,12 @@ let addrOff# = addr# `plusAddr#` off# -- The last parmaeter (`1#`) tells the import function to use big -- endian encoding.- in Gmp.importIntegerFromAddr addrOff# (int2Word# len#) 1#+ in+#if defined(HAVE_GHC_BIGNUM)+ BigNum.integerFromAddr (int2Word# len#) addrOff# 1#+#else+ Gmp.importIntegerFromAddr addrOff# (int2Word# len#) 1#+#endif #else uintegerFromBytes bs = case BS.uncons bs of
src/Codec/CBOR/Read.hs view
@@ -357,32 +357,32 @@ go_fast !bs da@(ConsumeWordCanonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeWord8Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#) ->+ DecodedToken sz w@(W# w#) -> case gtWord# w# 0xff## of- 0# | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da go_fast !bs da@(ConsumeWord16Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#) ->+ DecodedToken sz w@(W# w#) -> case gtWord# w# 0xffff## of- 0# | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da go_fast !bs da@(ConsumeWord32Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#) ->+ DecodedToken sz w@(W# w#) -> case w_out_of_range w# of- 0# | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da where w_out_of_range :: Word# -> Int#@@ -396,39 +396,39 @@ go_fast !bs da@(ConsumeNegWordCanonical k) = case tryConsumeNegWord (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeIntCanonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#)- | isIntCanonical sz n# -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz n@(I# n#)+ | isIntCanonical sz n -> k n# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeInt8Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case (n# ># 0x7f#) `orI#` (n# <# -0x80#) of- 0# | isIntCanonical sz n# -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da go_fast !bs da@(ConsumeInt16Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case (n# ># 0x7fff#) `orI#` (n# <# -0x8000#) of- 0# | isIntCanonical sz n# -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da go_fast !bs da@(ConsumeInt32Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case n_out_of_range n# of- 0# | isIntCanonical sz n# -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast (BS.unsafeDrop sz bs) _ -> go_fast_end bs da where n_out_of_range :: Int# -> Int#@@ -442,24 +442,24 @@ go_fast !bs da@(ConsumeListLenCanonical k) = case tryConsumeListLen (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#)- -- List length can't be negative, cast it to Word#.- | isWordCanonical sz (int2Word# n#) -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz n@(I# n#)+ -- List length can't be negative, cast it to Word.+ | isWordCanonical sz (intToWord n) -> k n# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeMapLenCanonical k) = case tryConsumeMapLen (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I# n#)- -- Map length can't be negative, cast it to Word#.- | isWordCanonical sz (int2Word# n#) -> k n# >>= go_fast (BS.unsafeDrop sz bs)- | otherwise -> go_fast_end bs da+ DecodedToken sz n@(I# n#)+ -- Map length can't be negative, cast it to Word.+ | isWordCanonical sz (intToWord n) -> k n# >>= go_fast (BS.unsafeDrop sz bs)+ | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeTagCanonical k) = case tryConsumeTag (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da #if defined(ARCH_32bit)@@ -496,45 +496,45 @@ go_fast !bs da@(ConsumeWord64Canonical k) = case tryConsumeWord64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeNegWord64Canonical k) = case tryConsumeNegWord64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeInt64Canonical k) = case tryConsumeInt64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I64# i#)- | isInt64Canonical sz i# -> k i# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz i@(I64# i#)+ | isInt64Canonical sz i -> k i# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeListLen64Canonical k) = case tryConsumeListLen64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I64# i#)+ DecodedToken sz i@(I64# i#) -- List length can't be negative, cast it to Word64#.- | isWord64Canonical sz (int64ToWord64# i#) -> k i# >>= go_fast (BS.unsafeDrop sz bs)- | otherwise -> go_fast_end bs da+ | isWord64Canonical sz (int64ToWord64 i) -> k i# >>= go_fast (BS.unsafeDrop sz bs)+ | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeMapLen64Canonical k) = case tryConsumeMapLen64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (I64# i#)+ DecodedToken sz i@(I64# i#) -- Map length can't be negative, cast it to Word64#.- | isWord64Canonical sz (int64ToWord64# i#) -> k i# >>= go_fast (BS.unsafeDrop sz bs)- | otherwise -> go_fast_end bs da+ | isWord64Canonical sz (int64ToWord64 i) -> k i# >>= go_fast (BS.unsafeDrop sz bs)+ | otherwise -> go_fast_end bs da go_fast !bs da@(ConsumeTag64Canonical k) = case tryConsumeTag64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast (BS.unsafeDrop sz bs) | otherwise -> go_fast_end bs da #endif @@ -838,31 +838,31 @@ go_fast_end !bs (ConsumeWordCanonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected word"- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical word" go_fast_end !bs (ConsumeWord8Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected word8"- DecodedToken sz (W# w#) -> case gtWord# w# 0xff## of- 0# | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#) -> case gtWord# w# 0xff## of+ 0# | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical word8" _ -> return $! SlowFail bs "expected word8" go_fast_end !bs (ConsumeWord16Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected word16"- DecodedToken sz (W# w#) -> case gtWord# w# 0xffff## of- 0# | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#) -> case gtWord# w# 0xffff## of+ 0# | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical word16" _ -> return $! SlowFail bs "expected word16" go_fast_end !bs (ConsumeWord32Canonical k) = case tryConsumeWord (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected word32"- DecodedToken sz (W# w#) -> case w_out_of_range w# of- 0# | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#) -> case w_out_of_range w# of+ 0# | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical word32" _ -> return $! SlowFail bs "expected word32" where@@ -877,41 +877,41 @@ go_fast_end !bs (ConsumeNegWordCanonical k) = case tryConsumeNegWord (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected negative int"- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical negative int" go_fast_end !bs (ConsumeIntCanonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int"- DecodedToken sz (I# n#)- | isIntCanonical sz n# -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz n@(I# n#)+ | isIntCanonical sz n -> k n# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical int" go_fast_end !bs (ConsumeInt8Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int8"- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case (n# ># 0x7f#) `orI#` (n# <# -0x80#) of- 0# | isIntCanonical sz n# -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical int8" _ -> return $! SlowFail bs "expected int8" go_fast_end !bs (ConsumeInt16Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int16"- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case (n# ># 0x7fff#) `orI#` (n# <# -0x8000#) of- 0# | isIntCanonical sz n# -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical int16" _ -> return $! SlowFail bs "expected int16" go_fast_end !bs (ConsumeInt32Canonical k) = case tryConsumeInt (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int32"- DecodedToken sz (I# n#) ->+ DecodedToken sz n@(I# n#) -> case n_out_of_range n# of- 0# | isIntCanonical sz n# -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ 0# | isIntCanonical sz n -> k n# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical int32" _ -> return $! SlowFail bs "expected int32" where@@ -926,24 +926,24 @@ go_fast_end !bs (ConsumeListLenCanonical k) = case tryConsumeListLen (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected list len"- DecodedToken sz (I# n#)+ DecodedToken sz n@(I# n#) -- List length can't be negative, cast it to Word#.- | isWordCanonical sz (int2Word# n#) -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)- | otherwise -> return $! SlowFail bs "non-canonical list len"+ | isWordCanonical sz (intToWord n) -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ | otherwise -> return $! SlowFail bs "non-canonical list len" go_fast_end !bs (ConsumeMapLenCanonical k) = case tryConsumeMapLen (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected map len"- DecodedToken sz (I# n#)+ DecodedToken sz n@(I# n#) -- Map length can't be negative, cast it to Word#.- | isWordCanonical sz (int2Word# n#) -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)- | otherwise -> return $! SlowFail bs "non-canonical map len"+ | isWordCanonical sz (intToWord n) -> k n# >>= go_fast_end (BS.unsafeDrop sz bs)+ | otherwise -> return $! SlowFail bs "non-canonical map len" go_fast_end !bs (ConsumeTagCanonical k) = case tryConsumeTag (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected tag"- DecodedToken sz (W# w#)- | isWordCanonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W# w#)+ | isWordCanonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical tag" #if defined(ARCH_32bit)@@ -980,30 +980,30 @@ go_fast_end !bs (ConsumeWord64Canonical k) = case tryConsumeWord64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected word64"- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical word64" go_fast_end !bs (ConsumeNegWord64Canonical k) = case tryConsumeNegWord64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected negative int"- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical negative int" go_fast_end !bs (ConsumeInt64Canonical k) = case tryConsumeInt64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int64"- DecodedToken sz (I64# i#)- | isInt64Canonical sz i# -> k i# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz i@(I64# i#)+ | isInt64Canonical sz i -> k i# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical int64" go_fast_end !bs (ConsumeListLen64Canonical k) = case tryConsumeListLen64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected list len 64"- DecodedToken sz (I64# i#)+ DecodedToken sz i@(I64# i#) -- List length can't be negative, cast it to Word64#.- | isWord64Canonical sz (int64ToWord64# i#) ->+ | isWord64Canonical sz (int64ToWord64 i) -> k i# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical list len 64"@@ -1011,9 +1011,9 @@ go_fast_end !bs (ConsumeMapLen64Canonical k) = case tryConsumeMapLen64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected map len 64"- DecodedToken sz (I64# i#)+ DecodedToken sz i@(I64# i#) -- Map length can't be negative, cast it to Word64#.- | isWord64Canonical sz (int64ToWord64# i#) ->+ | isWord64Canonical sz (int64ToWord64 i) -> k i# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical map len 64"@@ -1021,8 +1021,8 @@ go_fast_end !bs (ConsumeTag64Canonical k) = case tryConsumeTag64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected tag64"- DecodedToken sz (W64# w#)- | isWord64Canonical sz w# -> k w# >>= go_fast_end (BS.unsafeDrop sz bs)+ DecodedToken sz w@(W64# w#)+ | isWord64Canonical sz w -> k w# >>= go_fast_end (BS.unsafeDrop sz bs) | otherwise -> return $! SlowFail bs "non-canonical tag64" #endif@@ -1532,30 +1532,30 @@ | otherwise = sz == 9 {-# INLINE isWordCanonical #-}-isWordCanonical :: Int -> Word# -> Bool-isWordCanonical sz w#- | sz == 2 = isTrue# (w# `gtWord#` 0x17##)- | sz == 3 = isTrue# (w# `gtWord#` 0xff##)- | sz == 5 = isTrue# (w# `gtWord#` 0xffff##)- | sz == 9 = isTrue# (w# `gtWord#` 0xffffffff##)+isWordCanonical :: Int -> Word -> Bool+isWordCanonical sz !w+ | sz == 2 = w > 0x17+ | sz == 3 = w > 0xff+ | sz == 5 = w > 0xffff+ | sz == 9 = w > 0xffffffff | otherwise = True {-# INLINE isIntCanonical #-}-isIntCanonical :: Int -> Int# -> Bool-isIntCanonical sz i#- | isTrue# (i# <# 0#) = isWordCanonical sz (not# w#)- | otherwise = isWordCanonical sz w#+isIntCanonical :: Int -> Int -> Bool+isIntCanonical sz i+ | i < 0 = isWordCanonical sz (complement w)+ | otherwise = isWordCanonical sz w where- w# = int2Word# i#+ w = intToWord i #if defined(ARCH_32bit) {-# INLINE isWord64Canonical #-}-isWord64Canonical :: Int -> Word64# -> Bool-isWord64Canonical sz w#- | sz == 2 = isTrue# (w# `gtWord64#` wordToWord64# 0x17##)- | sz == 3 = isTrue# (w# `gtWord64#` wordToWord64# 0xff##)- | sz == 5 = isTrue# (w# `gtWord64#` wordToWord64# 0xffff##)- | sz == 9 = isTrue# (w# `gtWord64#` wordToWord64# 0xffffffff##)+isWord64Canonical :: Int -> Word64 -> Bool+isWord64Canonical sz w+ | sz == 2 = w > 0x17)+ | sz == 3 = w > 0xff)+ | sz == 5 = w > 0xffff)+ | sz == 9 = w > 0xffffffff) | otherwise = True {-# INLINE isInt64Canonical #-}@@ -1771,21 +1771,21 @@ 0x16 -> DecodedToken 1 (BigIntToken True 22) 0x17 -> DecodedToken 1 (BigIntToken True 23) - 0x18 -> let !w@(W8# w#) = eatTailWord8 bs+ 0x18 -> let !w = eatTailWord8 bs sz = 2- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w)- 0x19 -> let !w@(W16# w#) = eatTailWord16 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word8ToWord w)) $! toInteger w)+ 0x19 -> let !w = eatTailWord16 bs sz = 3- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w)- 0x1a -> let !w@(W32# w#) = eatTailWord32 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word16ToWord w)) $! toInteger w)+ 0x1a -> let !w = eatTailWord32 bs sz = 5- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w)- 0x1b -> let !w@(W64# w#) = eatTailWord64 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word32ToWord w)) $! toInteger w)+ 0x1b -> let !w = eatTailWord64 bs sz = 9 #if defined(ARCH_32bit)- in DecodedToken sz (BigIntToken (isWord64Canonical sz w#) $! toInteger w)+ in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! toInteger w) #else- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w)+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! toInteger w) #endif -- Negative integers (type 1)@@ -1813,21 +1813,21 @@ 0x35 -> DecodedToken 1 (BigIntToken True (-22)) 0x36 -> DecodedToken 1 (BigIntToken True (-23)) 0x37 -> DecodedToken 1 (BigIntToken True (-24))- 0x38 -> let !w@(W8# w#) = eatTailWord8 bs+ 0x38 -> let !w = eatTailWord8 bs sz = 2- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w))- 0x39 -> let !w@(W16# w#) = eatTailWord16 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word8ToWord w)) $! (-1 - toInteger w))+ 0x39 -> let !w = eatTailWord16 bs sz = 3- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w))- 0x3a -> let !w@(W32# w#) = eatTailWord32 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word16ToWord w)) $! (-1 - toInteger w))+ 0x3a -> let !w = eatTailWord32 bs sz = 5- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w))- 0x3b -> let !w@(W64# w#) = eatTailWord64 bs+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word32ToWord w)) $! (-1 - toInteger w))+ 0x3b -> let !w = eatTailWord64 bs sz = 9 #if defined(ARCH_32bit)- in DecodedToken sz (BigIntToken (isWord64Canonical sz w#) $! (-1 - toInteger w))+ in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! (-1 - toInteger w)) #else- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w))+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! (-1 - toInteger w)) #endif 0xc2 -> readBigUInt bs@@ -2503,8 +2503,8 @@ = DecodedToken hdrsz $ TooLong lengthCanonical n where hdrsz = 2- !n@(I# n#) = word8ToInt (eatTailWord8 bs)- lengthCanonical = isIntCanonical hdrsz n#+ !n = word8ToInt (eatTailWord8 bs)+ lengthCanonical = isIntCanonical hdrsz n readBytes16 bs | n <= BS.length bs - hdrsz@@ -2516,21 +2516,21 @@ = DecodedToken hdrsz $ TooLong lengthCanonical n where hdrsz = 3- !n@(I# n#) = word16ToInt (eatTailWord16 bs)- lengthCanonical = isIntCanonical hdrsz n#+ !n = word16ToInt (eatTailWord16 bs)+ lengthCanonical = isIntCanonical hdrsz n readBytes32 bs = case word32ToInt (eatTailWord32 bs) of #if defined(ARCH_32bit)- Just n@(I# n#)+ Just n #else- n@(I# n#)+ n #endif | n <= BS.length bs - hdrsz- -> DecodedToken (n+hdrsz) $ Fits (isIntCanonical hdrsz n#) $+ -> DecodedToken (n+hdrsz) $ Fits (isIntCanonical hdrsz n) $ BS.unsafeTake n (BS.unsafeDrop hdrsz bs) -- if n > bound then slow path, multi-chunk- | otherwise -> DecodedToken hdrsz $ TooLong (isIntCanonical hdrsz n#) n+ | otherwise -> DecodedToken hdrsz $ TooLong (isIntCanonical hdrsz n) n #if defined(ARCH_32bit) Nothing -> DecodeFailure@@ -2539,13 +2539,13 @@ hdrsz = 5 readBytes64 bs = case word64ToInt (eatTailWord64 bs) of- Just n@(I# n#)+ Just n | n <= BS.length bs - hdrsz- -> DecodedToken (n+hdrsz) $ Fits (isIntCanonical hdrsz n#) $+ -> DecodedToken (n+hdrsz) $ Fits (isIntCanonical hdrsz n) $ BS.unsafeTake n (BS.unsafeDrop hdrsz bs) -- if n > bound then slow path, multi-chunk- | otherwise -> DecodedToken hdrsz $ TooLong (isIntCanonical hdrsz n#) n+ | otherwise -> DecodedToken hdrsz $ TooLong (isIntCanonical hdrsz n) n Nothing -> DecodeFailure where
src/Codec/CBOR/Write.hs view
@@ -8,12 +8,9 @@ #include "cbor.h" -#if defined(OPTIMIZE_GMP)-#if __GLASGOW_HASKELL__ >= 900-#define HAVE_GHC_BIGNUM 1+#if defined(OPTIMIZE_GMP) && defined(HAVE_GHC_BIGNUM) {-# LANGUAGE UnboxedSums #-} #endif-#endif -- | -- Module : Codec.CBOR.Write@@ -51,11 +48,15 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import qualified Data.Text.Encoding as T+#if MIN_VERSION_text(2,0,0)+import qualified Data.Text.Foreign as T+#endif import Control.Exception.Base (assert) import GHC.Exts-import GHC.IO (IO(IO))+#if defined(OPTIMIZE_GMP) #if defined(HAVE_GHC_BIGNUM)+import GHC.IO (IO(IO)) import qualified GHC.Num.Integer import qualified GHC.Num.BigNat as Gmp import qualified GHC.Num.BigNat@@ -64,6 +65,7 @@ import qualified GHC.Integer.GMP.Internals as Gmp import GHC.Integer.GMP.Internals (BigNat) #endif+#endif #if __GLASGOW_HASKELL__ < 710 import GHC.Word@@ -420,9 +422,13 @@ stringMP :: T.Text -> B.Builder stringMP t =+#if MIN_VERSION_text(2,0,0)+ P.primBounded stringLenMP (fromIntegral $ T.lengthWord8 t) <> T.encodeUtf8Builder t+#else P.primBounded stringLenMP (fromIntegral $ S.length bs) <> B.byteString bs where bs = T.encodeUtf8 t+#endif stringLenMP :: P.BoundedPrim Word stringLenMP =@@ -605,7 +611,11 @@ #if defined(HAVE_GHC_BIGNUM) +{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}+pattern SmallInt :: Int# -> Integer pattern SmallInt n = GHC.Num.Integer.IS n++pattern PosBigInt, NegBigInt :: GHC.Num.BigNat.BigNat# -> Integer pattern PosBigInt n = GHC.Num.Integer.IP n pattern NegBigInt n = GHC.Num.Integer.IN n @@ -633,9 +643,14 @@ -- 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+#else /* HAVE_GHC_BIGNUM */ +{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}+pattern SmallInt :: Int# -> Integer pattern SmallInt n = Gmp.S# n++pattern PosBigInt :: BigNat -> Integer+pattern NegBigInt :: BigNat -> Integer pattern PosBigInt n = Gmp.Jp# n pattern NegBigInt n = Gmp.Jn# n @@ -653,12 +668,12 @@ P.primBounded header 0xc3 <> bigNatToBuilder (subtractOneBigNat n) where- subtractOneBigNat n = Gmp.minusBigNatWord n (int2Word# 1#)+ subtractOneBigNat m = Gmp.minusBigNatWord m (int2Word# 1#) exportBigNatToAddr bigNat addr# = -- The last parameter (`1#`) makes the export function use big endian encoding. Gmp.exportBigNatToAddr bigNat addr# 1#-#endif+#endif /* HAVE_GHC_BIGNUM */ bigNatToBuilder :: BigNat -> B.Builder bigNatToBuilder = bigNatBuilder@@ -680,7 +695,7 @@ sanity = isTrue# (sizeW# `eqWord#` written#) return $ assert sanity newPtr -#else+#else /* OPTIMIZE_GMP */ -- ---------------------- -- -- Generic implementation --@@ -703,4 +718,4 @@ narrow :: Integer -> Word8 narrow = fromIntegral-#endif+#endif /* OPTIMIZE_GMP */
src/cbits/cbor.h view
@@ -19,24 +19,6 @@ #endif /*-** Determine whether or not we can use more efficient code paths for-** integer-gmp.-*/--#if !defined(MIN_VERSION_integer_gmp)-/*-** In case this isn't defined, then just bail. If someone isn't using-** integer-gmp, then it won't be in the dependency list, so this macro-** might not(?) be generated by Cabal.-*/-#define MIN_VERSION_integer_gmp(x,y,z) 0-#endif--#if defined(FLAG_OPTIMIZE_GMP) && MIN_VERSION_integer_gmp(1,0,0)-#define OPTIMIZE_GMP-#endif--/* ** Establish the word-size of the machine, or fail. */ #if WORD_SIZE_IN_BITS == 64
tests/Tests/Properties.hs view
@@ -45,6 +45,7 @@ import qualified Numeric.Half as Half import Data.Function (on) import Data.Proxy+import Data.Kind (Type) import Codec.CBOR.Term import Codec.CBOR.Read@@ -99,7 +100,7 @@ -- We capture these types and arrows with a type class and an associated type. -- class (Eq t, Show t) => Token t where- type Imp t :: *+ type Imp t :: Type encodeImp :: Proxy t -> Imp t -> Encoding encodeRef :: Ref.Encoder t
tests/Tests/Reference.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} module Tests.Reference ( testTree@@ -16,6 +17,9 @@ import qualified Data.Vector as V import Data.Scientific (fromFloatDigits, toRealFloat) import Data.Aeson as Aeson+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.Key as Aeson.Key+#endif import Data.Word import qualified Numeric.Half as Half @@ -68,6 +72,13 @@ equalJson expected actual = expected @=? actual +#if MIN_VERSION_aeson(2,0,0)+stringToJsonKey :: String -> Aeson.Key.Key+stringToJsonKey = Aeson.Key.fromString+#else+stringToJsonKey :: String -> T.Text+stringToJsonKey = T.pack+#endif termToJson :: CBOR.Term -> Aeson.Value termToJson (TUInt n) = Aeson.Number (fromIntegral (fromUInt n))@@ -79,9 +90,9 @@ termToJson (TStrings css) = Aeson.String (T.pack (concat css)) termToJson (TArray ts) = Aeson.Array (V.fromList (map termToJson ts)) termToJson (TArrayI ts) = Aeson.Array (V.fromList (map termToJson ts))-termToJson (TMap kvs) = Aeson.object [ (T.pack k, termToJson v)+termToJson (TMap kvs) = Aeson.object [ (stringToJsonKey k, termToJson v) | (TString k,v) <- kvs ]-termToJson (TMapI kvs) = Aeson.object [ (T.pack k, termToJson v)+termToJson (TMapI kvs) = Aeson.object [ (stringToJsonKey k, termToJson v) | (TString k,v) <- kvs ] termToJson (TTagged _ t) = termToJson t termToJson TTrue = Aeson.Bool True