Fix 32 bit compilation

well-typed · Jun 12, 2023 · fe0aac0 · fe0aac0
1 parent 4149849
commit fe0aac0
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 30 deletions.
diff --git 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
@@ -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
@@ -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