Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-cborg for openSUSE:Factory checked in at 2021-11-11 21:36:18 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-cborg (Old) and /work/SRC/openSUSE:Factory/.ghc-cborg.new.1890 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-cborg" Thu Nov 11 21:36:18 2021 rev:7 rq:930314 version:0.2.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-cborg/ghc-cborg.changes 2021-09-10 23:41:20.286561097 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-cborg.new.1890/ghc-cborg.changes 2021-11-11 21:36:22.688886733 +0100 @@ -1,0 +2,18 @@ +Mon Nov 1 08:22:00 UTC 2021 - [email protected] + +- Update cborg to version 0.2.6.0. + ## 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) + +------------------------------------------------------------------- Old: ---- cborg-0.2.5.0.tar.gz cborg.cabal New: ---- cborg-0.2.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-cborg.spec ++++++ --- /var/tmp/diff_new_pack.MNrtKn/_old 2021-11-11 21:36:23.196887103 +0100 +++ /var/tmp/diff_new_pack.MNrtKn/_new 2021-11-11 21:36:23.200887106 +0100 @@ -19,13 +19,12 @@ %global pkg_name cborg %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.5.0 +Version: 0.2.6.0 Release: 0 Summary: Concise Binary Object Representation (CBOR) License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-array-devel BuildRequires: ghc-bytestring-devel @@ -78,7 +77,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ cborg-0.2.5.0.tar.gz -> cborg-0.2.6.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/ChangeLog.md new/cborg-0.2.6.0/ChangeLog.md --- old/cborg-0.2.5.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/cborg.cabal new/cborg-0.2.6.0/cborg.cabal --- old/cborg-0.2.5.0/cborg.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/cborg.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -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, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/Codec/CBOR/Decoding.hs new/cborg-0.2.6.0/src/Codec/CBOR/Decoding.hs --- old/cborg-0.2.5.0/src/Codec/CBOR/Decoding.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/Codec/CBOR/Decoding.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 #-} -------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/Codec/CBOR/FlatTerm.hs new/cborg-0.2.6.0/src/Codec/CBOR/FlatTerm.hs --- old/cborg-0.2.5.0/src/Codec/CBOR/FlatTerm.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/Codec/CBOR/FlatTerm.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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# diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/Codec/CBOR/Magic.hs new/cborg-0.2.6.0/src/Codec/CBOR/Magic.hs --- old/cborg-0.2.5.0/src/Codec/CBOR/Magic.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/Codec/CBOR/Magic.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 + + , intToWord -- :: Int -> Word + , intToInt64 -- :: Int -> Int64 + + , intToWord64 -- :: Int -> Word64 + , int64ToWord64 -- :: Int64 -> Word64 - , intToInt64 -- :: Int -> Int64 #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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/Codec/CBOR/Read.hs new/cborg-0.2.6.0/src/Codec/CBOR/Read.hs --- old/cborg-0.2.5.0/src/Codec/CBOR/Read.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/Codec/CBOR/Read.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/Codec/CBOR/Write.hs new/cborg-0.2.6.0/src/Codec/CBOR/Write.hs --- old/cborg-0.2.5.0/src/Codec/CBOR/Write.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/Codec/CBOR/Write.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 */ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/src/cbits/cbor.h new/cborg-0.2.6.0/src/cbits/cbor.h --- old/cborg-0.2.5.0/src/cbits/cbor.h 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/src/cbits/cbor.h 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/tests/Tests/Properties.hs new/cborg-0.2.6.0/tests/Tests/Properties.hs --- old/cborg-0.2.5.0/tests/Tests/Properties.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/tests/Tests/Properties.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cborg-0.2.5.0/tests/Tests/Reference.hs new/cborg-0.2.6.0/tests/Tests/Reference.hs --- old/cborg-0.2.5.0/tests/Tests/Reference.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/cborg-0.2.6.0/tests/Tests/Reference.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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
