diff --git a/cborg/src/Codec/CBOR/Decoding.hs b/cborg/src/Codec/CBOR/Decoding.hs index a7d774c..c0bc17d 100644 --- a/cborg/src/Codec/CBOR/Decoding.hs +++ b/cborg/src/Codec/CBOR/Decoding.hs @@ -315,11 +315,13 @@ getDecodeAction (Decoder k) = k (\x -> return (Done x)) toInt8 :: Int# -> Int8 toInt16 :: Int# -> Int16 toInt32 :: Int# -> Int32 -toInt64 :: Int# -> Int64 toWord8 :: Word# -> Word8 toWord16 :: Word# -> Word16 toWord32 :: Word# -> Word32 +#if WORD_SIZE_IN_BITS == 64 +toInt64 :: Int# -> Int64 toWord64 :: Word# -> Word64 +#endif #if MIN_VERSION_ghc_prim(0,8,0) toInt8 n = I8# (intToInt8# n) toInt16 n = I16# (intToInt16# n) @@ -335,20 +337,19 @@ toWord64 n = W64# (wordToWord64# n) toInt64 n = I64# n toWord64 n = W64# n #endif -#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 +#if WORD_SIZE_IN_BITS == 64 +toInt64 n = I64# n toWord64 n = W64# n #endif +#endif -- $canonical -- @@ -423,7 +424,7 @@ decodeWord64 = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeWord (\w# -> k (toWord64 w#)))) #else - Decoder (\k -> return (ConsumeWord64 (\w64# -> k (toWord64 w64#)))) + Decoder (\k -> return (ConsumeWord64 (\w64# -> k (W64# w64#)))) #endif -- | Decode a negative 'Word'. @@ -442,7 +443,7 @@ decodeNegWord64 = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeNegWord (\w# -> k (toWord64 w#)))) #else - Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (toWord64 w64#)))) + Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (W64# w64#)))) #endif -- | Decode an 'Int'. @@ -482,7 +483,7 @@ decodeInt64 = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeInt (\n# -> k (toInt64 n#)))) #else - Decoder (\k -> return (ConsumeInt64 (\n64# -> k (toInt64 n64#)))) + Decoder (\k -> return (ConsumeInt64 (\n64# -> k (I64# n64#)))) #endif -- | Decode canonical representation of a 'Word'. @@ -522,7 +523,7 @@ decodeWord64Canonical = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (toWord64 w#)))) #else - Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (toWord64 w64#)))) + Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (W64# w64#)))) #endif -- | Decode canonical representation of a negative 'Word'. @@ -541,7 +542,7 @@ decodeNegWord64Canonical = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (toWord64 w#)))) #else - Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (toWord64 w64#)))) + Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (W64# w64#)))) #endif -- | Decode canonical representation of an 'Int'. @@ -581,7 +582,7 @@ decodeInt64Canonical = #if defined(ARCH_64bit) Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (toInt64 n#)))) #else - Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (toInt64 n64#)))) + Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (I64# n64#)))) #endif -- | Decode an 'Integer'. @@ -986,7 +987,7 @@ type ByteOffset = Int64 -- @since 0.2.2.0 peekByteOffset :: Decoder s ByteOffset peekByteOffset = Decoder (\k -> return (PeekByteOffset (\off# -> k (I64# -#if MIN_VERSION_base(4,17,0) +#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit) (intToInt64# off#) #else off# diff --git a/cborg/src/Codec/CBOR/Magic.hs b/cborg/src/Codec/CBOR/Magic.hs index cdeb455..bfae638 100644 --- a/cborg/src/Codec/CBOR/Magic.hs +++ b/cborg/src/Codec/CBOR/Magic.hs @@ -120,7 +120,7 @@ import qualified Numeric.Half as Half import Data.Bits ((.|.), unsafeShiftL) #endif -#if defined(ARCH_32bit) +#if defined(ARCH_32bit) && !MIN_VERSION_ghc_prim(0,8,0) import GHC.IntWord64 (wordToWord64#, word64ToWord#, intToInt64#, int64ToInt#, leWord64#, ltWord64#, word64ToInt64#) @@ -173,7 +173,7 @@ grabWord64 (Ptr ip#) = W64# (wordToWord64# (byteSwap# (word64ToWord# (indexWord6 grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#)) #endif #else -grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#))) +grabWord64 (Ptr ip#) = W64# (byteSwap64# (indexWord64OffAddr# ip# 0#)) #endif #elif defined(MEM_UNALIGNED_OPS) && \ @@ -484,7 +484,7 @@ word16ToInt (W16# w#) = I# (word2Int# (word16ToWord# w#)) word32ToInt (W32# w#) = I# (word2Int# (word32ToWord# w#)) #else word32ToInt (W32# w#) = - case isTrue# (w# `ltWord#` 0x80000000##) of + case isTrue# (word32ToWord# w# `ltWord#` 0x80000000##) of True -> Just (I# (word2Int# (word32ToWord# w#))) False -> Nothing #endif @@ -530,6 +530,19 @@ word64ToInt (W64# w#) = {-# INLINE word64ToInt #-} #if defined(ARCH_32bit) +#if MIN_VERSION_ghc_prim(0,8,0) +word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# (word8ToWord# w#))) +word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# (word16ToWord# w#))) +word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# (word32ToWord# w#))) +word64ToInt64 (W64# w#) = + case isTrue# (w# `ltWord64#` uncheckedShiftL64# (wordToWord64# 1##) 63#) of + True -> Just (I64# (word64ToInt64# w#)) + False -> Nothing + +word8ToWord64 (W8# w#) = W64# (wordToWord64# (word8ToWord# w#)) +word16ToWord64 (W16# w#) = W64# (wordToWord64# (word16ToWord# w#)) +word32ToWord64 (W32# w#) = W64# (wordToWord64# (word32ToWord# w#)) +#else word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# w#)) word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# w#)) word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# w#)) @@ -541,6 +554,7 @@ word64ToInt64 (W64# w#) = word8ToWord64 (W8# w#) = W64# (wordToWord64# w#) word16ToWord64 (W16# w#) = W64# (wordToWord64# w#) word32ToWord64 (W32# w#) = W64# (wordToWord64# w#) +#endif {-# INLINE word8ToInt64 #-} {-# INLINE word16ToInt64 #-} diff --git a/cborg/src/Codec/CBOR/Read.hs b/cborg/src/Codec/CBOR/Read.hs index 6546575..c4dc761 100644 --- a/cborg/src/Codec/CBOR/Read.hs +++ b/cborg/src/Codec/CBOR/Read.hs @@ -63,7 +63,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Word import GHC.Word -#if defined(ARCH_32bit) +#if defined(ARCH_32bit) && !MIN_VERSION_ghc_prim(0,8,0) import GHC.IntWord64 #endif import GHC.Exts @@ -510,8 +510,8 @@ go_fast !bs da@(ConsumeNegWord64Canonical k) = go_fast !bs da@(ConsumeInt64Canonical k) = case tryConsumeInt64 (BS.unsafeHead bs) bs of DecodeFailure -> go_fast_end bs da - DecodedToken sz i@(I64# i#) - | isInt64Canonical sz i -> k i# >>= go_fast (BS.unsafeDrop sz bs) + DecodedToken sz (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) = @@ -994,8 +994,8 @@ go_fast_end !bs (ConsumeNegWord64Canonical k) = go_fast_end !bs (ConsumeInt64Canonical k) = case tryConsumeInt64 (BS.unsafeHead bs) bs of DecodeFailure -> return $! SlowFail bs "expected int64" - DecodedToken sz i@(I64# i#) - | isInt64Canonical sz i -> k i# >>= go_fast_end (BS.unsafeDrop sz bs) + DecodedToken sz (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) = @@ -1271,7 +1271,7 @@ go_slow da bs !offset = do SlowPeekByteOffset bs' k -> lift -#if MIN_VERSION_base(4,17,0) +#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit) (k (int64ToInt# off#)) #else (k off#) @@ -1381,7 +1381,7 @@ go_slow_overlapped da sz bs_cur bs_next !offset = SlowPeekByteOffset bs_empty k -> assert (BS.null bs_empty) $ do lift -#if MIN_VERSION_base(4,17,0) +#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit) (k (int64ToInt# off#)) #else (k off#) @@ -1565,17 +1565,17 @@ isIntCanonical sz i {-# INLINE isWord64Canonical #-} isWord64Canonical :: Int -> Word64 -> Bool isWord64Canonical sz w - | sz == 2 = w > 0x17) - | sz == 3 = w > 0xff) - | sz == 5 = w > 0xffff) - | sz == 9 = w > 0xffffffff) + | sz == 2 = w > 0x17 + | sz == 3 = w > 0xff + | sz == 5 = w > 0xffff + | sz == 9 = w > 0xffffffff | otherwise = True {-# INLINE isInt64Canonical #-} isInt64Canonical :: Int -> Int64# -> Bool isInt64Canonical sz i# - | isTrue# (i# `ltInt64#` intToInt64# 0#) = isWord64Canonical sz (not64# w#) - | otherwise = isWord64Canonical sz w# + | isTrue# (i# `ltInt64#` intToInt64# 0#) = isWord64Canonical sz (W64# (not64# w#)) + | otherwise = isWord64Canonical sz (W64# w#) where w# = int64ToWord64# i# #endif @@ -1796,7 +1796,7 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of 0x1b -> let !w = eatTailWord64 bs sz = 9 #if defined(ARCH_32bit) - in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! toInteger w) + in DecodedToken sz (BigIntToken (isWord64Canonical sz w) $! toInteger w) #else in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! toInteger w) #endif @@ -1838,7 +1838,7 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of 0x3b -> let !w = eatTailWord64 bs sz = 9 #if defined(ARCH_32bit) - in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! (-1 - toInteger w)) + in DecodedToken sz (BigIntToken (isWord64Canonical sz w) $! (-1 - toInteger w)) #else in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! (-1 - toInteger w)) #endif