Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make compatible with new GHC JS backend #335

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions .github/workflows/haskell-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,11 @@ jobs:
strategy:
matrix:
include:
- compiler: ghc-9.8.1
compilerKind: ghcjs
compilerVersion: 9.8.1
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.8.1
compilerKind: ghc
compilerVersion: 9.8.1
Expand Down
22 changes: 11 additions & 11 deletions cborg/src/Codec/CBOR/Decoding.hs
Original file line number Diff line number Diff line change
Expand Up @@ -157,7 +157,7 @@ data DecodeAction s a
| ConsumeTag (Word# -> ST s (DecodeAction s a))

-- 64bit variants for 32bit machines
#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
| ConsumeWord64 (Word64# -> ST s (DecodeAction s a))
| ConsumeNegWord64 (Word64# -> ST s (DecodeAction s a))
| ConsumeInt64 (Int64# -> ST s (DecodeAction s a))
Expand Down Expand Up @@ -188,7 +188,7 @@ data DecodeAction s a

| PeekTokenType (TokenType -> ST s (DecodeAction s a))
| PeekAvailable (Int# -> ST s (DecodeAction s a))
#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
| PeekByteOffset (Int64# -> ST s (DecodeAction s a))
#else
| PeekByteOffset (Int# -> ST s (DecodeAction s a))
Expand All @@ -208,7 +208,7 @@ data DecodeAction s a
| ConsumeMapLenCanonical (Int# -> ST s (DecodeAction s a))
| ConsumeTagCanonical (Word# -> ST s (DecodeAction s a))

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
| ConsumeWord64Canonical (Word64# -> ST s (DecodeAction s a))
| ConsumeNegWord64Canonical (Word64# -> ST s (DecodeAction s a))
| ConsumeInt64Canonical (Int64# -> ST s (DecodeAction s a))
Expand Down Expand Up @@ -420,7 +420,7 @@ decodeWord32 = Decoder (\k -> return (ConsumeWord32 (\w# -> k (toWord32 w#))))
decodeWord64 :: Decoder s Word64
{-# INLINE decodeWord64 #-}
decodeWord64 =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeWord (\w# -> k (toWord64 w#))))
#else
Decoder (\k -> return (ConsumeWord64 (\w64# -> k (toWord64 w64#))))
Expand All @@ -439,7 +439,7 @@ decodeNegWord = Decoder (\k -> return (ConsumeNegWord (\w# -> k (W# w#))))
decodeNegWord64 :: Decoder s Word64
{-# INLINE decodeNegWord64 #-}
decodeNegWord64 =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeNegWord (\w# -> k (toWord64 w#))))
#else
Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (toWord64 w64#))))
Expand Down Expand Up @@ -479,7 +479,7 @@ decodeInt32 = Decoder (\k -> return (ConsumeInt32 (\w# -> k (toInt32 w#))))
decodeInt64 :: Decoder s Int64
{-# INLINE decodeInt64 #-}
decodeInt64 =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeInt (\n# -> k (toInt64 n#))))
#else
Decoder (\k -> return (ConsumeInt64 (\n64# -> k (toInt64 n64#))))
Expand Down Expand Up @@ -519,7 +519,7 @@ decodeWord32Canonical = Decoder (\k -> return (ConsumeWord32Canonical (\w# -> k
decodeWord64Canonical :: Decoder s Word64
{-# INLINE decodeWord64Canonical #-}
decodeWord64Canonical =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (toWord64 w#))))
#else
Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (toWord64 w64#))))
Expand All @@ -538,7 +538,7 @@ decodeNegWordCanonical = Decoder (\k -> return (ConsumeNegWordCanonical (\w# ->
decodeNegWord64Canonical :: Decoder s Word64
{-# INLINE decodeNegWord64Canonical #-}
decodeNegWord64Canonical =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (toWord64 w#))))
#else
Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (toWord64 w64#))))
Expand Down Expand Up @@ -578,7 +578,7 @@ decodeInt32Canonical = Decoder (\k -> return (ConsumeInt32Canonical (\w# -> k (t
decodeInt64Canonical :: Decoder s Int64
{-# INLINE decodeInt64Canonical #-}
decodeInt64Canonical =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (toInt64 n#))))
#else
Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (toInt64 n64#))))
Expand Down Expand Up @@ -752,7 +752,7 @@ decodeTag = Decoder (\k -> return (ConsumeTag (\w# -> k (W# w#))))
decodeTag64 :: Decoder s Word64
{-# INLINE decodeTag64 #-}
decodeTag64 =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeTag (\w# -> k (W64#
#if MIN_VERSION_base(4,17,0)
(wordToWord64# w#)
Expand All @@ -779,7 +779,7 @@ decodeTagCanonical = Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W# w#
decodeTag64Canonical :: Decoder s Word64
{-# INLINE decodeTag64Canonical #-}
decodeTag64Canonical =
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W64#
#if MIN_VERSION_base(4,17,0)
(wordToWord64# w#)
Expand Down
8 changes: 4 additions & 4 deletions cborg/src/Codec/CBOR/FlatTerm.hs
Original file line number Diff line number Diff line change
Expand Up @@ -385,7 +385,7 @@ fromFlatTerm decoder ft =
go (TkTag n : ts) (ConsumeTagCanonical k)
| n <= maxWord = k (unW# (fromIntegral n)) >>= go ts

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
-- 64bit variants for 32bit machines
go (TkInt n : ts) (ConsumeWord64 k)
| n >= 0 = k (unW64# (fromIntegral n)) >>= go ts
Expand Down Expand Up @@ -468,7 +468,7 @@ fromFlatTerm decoder ft =
-- We don't have real bytes so we have to give these two operations
-- different interpretations: remaining tokens and just 0 for offsets.
go ts (PeekAvailable k) = k (unI# (length ts)) >>= go ts
#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
go ts (PeekByteOffset k)= k (unI64# 0) >>= go ts
#else
go ts (PeekByteOffset k)= k 0# >>= go ts
Expand Down Expand Up @@ -529,7 +529,7 @@ fromFlatTerm decoder ft =
go ts (ConsumeUtf8ByteArrayCanonical _) = unexpected "decodeUtf8ByteArrayCanonical" ts
go ts (ConsumeSimpleCanonical _) = unexpected "decodeSimpleCanonical" ts

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
-- 64bit variants for 32bit machines
go ts (ConsumeWord64 _) = unexpected "decodeWord64" ts
go ts (ConsumeNegWord64 _) = unexpected "decodeNegWord64" ts
Expand Down Expand Up @@ -744,7 +744,7 @@ unF# (F# f#) = f#
unD# :: Double -> Double#
unD# (D# f#) = f#

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
unW64# :: Word64 -> Word64#
unW64# (W64# w#) = w#

Expand Down
31 changes: 18 additions & 13 deletions cborg/src/Codec/CBOR/Magic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ module Codec.CBOR.Magic
, intToWord64 -- :: Int -> Word64
, int64ToWord64 -- :: Int64 -> Word64

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
, word8ToInt64 -- :: Word8 -> Int64
, word16ToInt64 -- :: Word16 -> Int64
, word32ToInt64 -- :: Word32 -> Int64
Expand Down Expand Up @@ -121,10 +121,15 @@ import Data.Bits ((.|.), unsafeShiftL)
#endif

#if defined(ARCH_32bit)
#if MIN_VERSION_ghc_prim(0,8,0)
import GHC.Exts (wordToWord64#, word64ToWord#,
intToInt64#, int64ToInt#,
leWord64#, ltWord64#, word64ToInt64#)
#else
import GHC.IntWord64 (wordToWord64#, word64ToWord#,
intToInt64#, int64ToInt#,
leWord64#, ltWord64#, word64ToInt64#)

#endif
#endif

--------------------------------------------------------------------------------
Expand Down Expand Up @@ -166,7 +171,7 @@ grabWord32 (Ptr ip#) = W32# (wordToWord32# (byteSwap32# (word32ToWord# (indexWor
grabWord16 (Ptr ip#) = W16# (narrow16Word# (byteSwap16# (indexWord16OffAddr# ip# 0#)))
grabWord32 (Ptr ip#) = W32# (narrow32Word# (byteSwap32# (indexWord32OffAddr# ip# 0#)))
#endif
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
#if MIN_VERSION_base(4,17,0)
grabWord64 (Ptr ip#) = W64# (wordToWord64# (byteSwap# (word64ToWord# (indexWord64OffAddr# ip# 0#))))
#else
Expand Down Expand Up @@ -379,7 +384,7 @@ wordToFloat64 (W64# w#) = D# (wordToFloat64# w#)
{-# INLINE wordToFloat64 #-}

-- | Cast an unboxed word to an unboxed double.
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
wordToFloat64# :: Word# -> Double#
#else
wordToFloat64# :: Word64# -> Double#
Expand All @@ -400,22 +405,22 @@ wordToFloat64# w# =
word8ToWord :: Word8 -> Word
word16ToWord :: Word16 -> Word
word32ToWord :: Word32 -> Word
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word64ToWord :: Word64 -> Word
#else
word64ToWord :: Word64 -> Maybe Word
#endif

word8ToInt :: Word8 -> Int
word16ToInt :: Word16 -> Int
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word32ToInt :: Word32 -> Int
#else
word32ToInt :: Word32 -> Maybe Int
#endif
word64ToInt :: Word64 -> Maybe Int

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
word8ToInt64 :: Word8 -> Int64
word16ToInt64 :: Word16 -> Int64
word32ToInt64 :: Word32 -> Int64
Expand Down Expand Up @@ -446,7 +451,7 @@ int64ToWord64 = fromIntegral
word8ToWord (W8# w#) = W# (word8ToWord# w#)
word16ToWord (W16# w#) = W# (word16ToWord# w#)
word32ToWord (W32# w#) = W# (word32ToWord# w#)
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
#if MIN_VERSION_base(4,17,0)
word64ToWord (W64# w#) = W# (word64ToWord# w#)
#else
Expand All @@ -462,7 +467,7 @@ word64ToWord (W64# w64#) =
word8ToWord (W8# w#) = W# w#
word16ToWord (W16# w#) = W# w#
word32ToWord (W32# w#) = W# w#
#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word64ToWord (W64# w#) = W# w#
#else
word64ToWord (W64# w64#) =
Expand All @@ -480,7 +485,7 @@ word64ToWord (W64# w64#) =
#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)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word32ToInt (W32# w#) = I# (word2Int# (word32ToWord# w#))
#else
word32ToInt (W32# w#) =
Expand All @@ -492,7 +497,7 @@ word32ToInt (W32# w#) =
word8ToInt (W8# w#) = I# (word2Int# w#)
word16ToInt (W16# w#) = I# (word2Int# w#)

#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word32ToInt (W32# w#) = I# (word2Int# w#)
#else
word32ToInt (W32# w#) =
Expand All @@ -502,7 +507,7 @@ word32ToInt (W32# w#) =
#endif
#endif

#if defined(ARCH_64bit)
#if defined(ARCH_64bit) || defined(ghcjs_HOST_OS)
word64ToInt (W64# w#) =
#if MIN_VERSION_base(4,17,0)
case isTrue# (word64ToWord# w# `ltWord#` 0x8000000000000000##) of
Expand All @@ -529,7 +534,7 @@ word64ToInt (W64# w#) =
{-# INLINE word32ToInt #-}
{-# INLINE word64ToInt #-}

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !defined(ghcjs_HOST_OS)
word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# w#))
word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# w#))
word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# w#))
Expand Down
Loading