diff --git a/patches/basement-0.0.12.patch b/patches/basement-0.0.12.patch index 3621b590b0bd5fb1dea3cfbd2da9504765a6b5f2..7f495fba8510026d0ef22996e069c781f11cd132 100644 --- a/patches/basement-0.0.12.patch +++ b/patches/basement-0.0.12.patch @@ -138,10 +138,18 @@ index 3ed321d..ec7da5a 100644 data Table = Table Addr# diff --git a/Basement/Bits.hs b/Basement/Bits.hs -index f304a86..9a48c3c 100644 +index f304a86..c7255c7 100644 --- a/Basement/Bits.hs +++ b/Basement/Bits.hs -@@ -41,6 +41,7 @@ import Basement.Types.Word256 (Word256) +@@ -31,6 +31,7 @@ module Basement.Bits + + import Basement.Compat.Base + import Basement.Compat.Natural ++import Basement.HeadHackageUtils + import Basement.Numerical.Additive + import Basement.Numerical.Subtractive + import Basement.Numerical.Multiplicative +@@ -41,6 +42,7 @@ import Basement.Types.Word256 (Word256) import qualified Basement.Types.Word256 as Word256 import Basement.IntegralConv (wordToInt) import Basement.Nat @@ -149,7 +157,7 @@ index f304a86..9a48c3c 100644 import qualified Prelude import qualified Data.Bits as OldBits -@@ -237,27 +238,27 @@ instance FiniteBitsOps Word8 where +@@ -237,27 +239,27 @@ instance FiniteBitsOps Word8 where numberOfBits _ = 8 rotateL (W8# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W8# x# @@ -190,7 +198,7 @@ index f304a86..9a48c3c 100644 -- Word16 --------------------------------------------------------------------- -@@ -265,27 +266,27 @@ instance FiniteBitsOps Word16 where +@@ -265,27 +267,27 @@ instance FiniteBitsOps Word16 where numberOfBits _ = 16 rotateL (W16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W16# x# @@ -231,7 +239,7 @@ index f304a86..9a48c3c 100644 -- Word32 --------------------------------------------------------------------- -@@ -293,27 +294,27 @@ instance FiniteBitsOps Word32 where +@@ -293,27 +295,27 @@ instance FiniteBitsOps Word32 where numberOfBits _ = 32 rotateL (W32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W32# x# @@ -272,7 +280,58 @@ index f304a86..9a48c3c 100644 -- Word --------------------------------------------------------------------- -@@ -463,28 +464,28 @@ instance FiniteBitsOps Int8 where +@@ -334,9 +336,9 @@ instance FiniteBitsOps Word where + !i'# = word2Int# (int2Word# i# `and#` 63##) + bitFlip (W# x#) = W# (x# `xor#` mb#) + where !(W# mb#) = maxBound +- popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# x#)) +- countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# w#)) +- countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# w#)) ++ popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# (wordToWord64Compat# x#))) ++ countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# (wordToWord64Compat# w#))) ++ countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# (wordToWord64Compat# w#))) + #else + instance FiniteBitsOps Word where + numberOfBits _ = 32 +@@ -373,27 +375,27 @@ instance FiniteBitsOps Word64 where + numberOfBits _ = 64 + rotateL (W64# x#) (CountOf (I# i#)) + | isTrue# (i'# ==# 0#) = W64# x# +- | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#` +- (x# `uncheckedShiftRL#` (64# -# i'#))) ++ | otherwise = W64# ((x# `uncheckedShiftL64Compat#` i'#) `or64Compat#` ++ (x# `uncheckedShiftRL64Compat#` (64# -# i'#))) + where + !i'# = word2Int# (int2Word# i# `and#` 63##) + rotateR (W64# x#) (CountOf (I# i#)) + | isTrue# (i'# ==# 0#) = W64# x# +- | otherwise = W64# ((x# `uncheckedShiftRL#` i'#) `or#` +- (x# `uncheckedShiftL#` (64# -# i'#))) ++ | otherwise = W64# ((x# `uncheckedShiftRL64Compat#` i'#) `or64Compat#` ++ (x# `uncheckedShiftL64Compat#` (64# -# i'#))) + where + !i'# = word2Int# (int2Word# i# `and#` 63##) +- bitFlip (W64# x#) = W64# (x# `xor#` mb#) ++ bitFlip (W64# x#) = W64# (x# `xor64Compat#` mb#) + where !(W64# mb#) = maxBound + popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#)) + countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#)) + countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#)) + instance BitOps Word64 where +- (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) +- (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) +- (W64# x#) .^. (W64# y#) = W64# (x# `xor#` y#) +- (W64# x#) .<<. (CountOf (I# i#)) = W64# (x# `shiftL#` i#) +- (W64# x#) .>>. (CountOf (I# i#)) = W64# (x# `shiftRL#` i#) ++ (W64# x#) .&. (W64# y#) = W64# (x# `and64Compat#` y#) ++ (W64# x#) .|. (W64# y#) = W64# (x# `or64Compat#` y#) ++ (W64# x#) .^. (W64# y#) = W64# (x# `xor64Compat#` y#) ++ (W64# x#) .<<. (CountOf (I# i#)) = W64# (wordToWord64Compat# (word64ToWordCompat# x# `shiftL#` i#)) ++ (W64# x#) .>>. (CountOf (I# i#)) = W64# (wordToWord64Compat# (word64ToWordCompat# x# `shiftRL#` i#)) + #else + instance FiniteBitsOps Word64 where + numberOfBits _ = 64 +@@ -463,28 +465,28 @@ instance FiniteBitsOps Int8 where numberOfBits _ = 8 rotateL (I8# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I8# x# @@ -314,7 +373,7 @@ index f304a86..9a48c3c 100644 -- Int16 ---------------------------------------------------------------------- -@@ -492,28 +493,28 @@ instance FiniteBitsOps Int16 where +@@ -492,28 +494,28 @@ instance FiniteBitsOps Int16 where numberOfBits _ = 16 rotateL (I16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I16# x# @@ -356,7 +415,7 @@ index f304a86..9a48c3c 100644 -- Int32 ---------------------------------------------------------------------- -@@ -521,28 +522,28 @@ instance FiniteBitsOps Int32 where +@@ -521,28 +523,28 @@ instance FiniteBitsOps Int32 where numberOfBits _ = 32 rotateL (I32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I32# x# @@ -398,8 +457,54 @@ index f304a86..9a48c3c 100644 -- Int64 ---------------------------------------------------------------------- +@@ -551,28 +553,30 @@ instance FiniteBitsOps Int64 where + numberOfBits _ = 64 + rotateL (I64# x#) (CountOf (I# i#)) + | isTrue# (i'# ==# 0#) = I64# x# +- | otherwise = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` +- (x'# `uncheckedShiftRL#` (64# -# i'#)))) ++ | otherwise = I64# (word64ToInt64Compat# ++ ((x'# `uncheckedShiftL64Compat#` i'#) `or64Compat#` ++ (x'# `uncheckedShiftRL64Compat#` (64# -# i'#)))) + where +- !x'# = int2Word# x# ++ !x'# = int64ToWord64Compat# x# + !i'# = word2Int# (int2Word# i# `and#` 63##) + rotateR (I64# x#) (CountOf (I# i#)) + | isTrue# (i'# ==# 0#) = I64# x# +- | otherwise = I64# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#` +- (x'# `uncheckedShiftL#` (64# -# i'#)))) ++ | otherwise = I64# (word64ToInt64Compat# ++ ((x'# `uncheckedShiftRL64Compat#` i'#) `or64Compat#` ++ (x'# `uncheckedShiftL64Compat#` (64# -# i'#)))) + where +- !x'# = int2Word# x# ++ !x'# = int64ToWord64Compat# x# + !i'# = word2Int# (int2Word# i# `and#` 63##) +- bitFlip (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#))) +- popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int2Word# x#))) +- countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int2Word# w#))) +- countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int2Word# w#))) ++ bitFlip (I64# x#) = I64# (word64ToInt64Compat# (int64ToWord64Compat# x# `xor64Compat#` int64ToWord64Compat# (intToInt64Compat# (-1#)))) ++ popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int64ToWord64Compat# x#))) ++ countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int64ToWord64Compat# w#))) ++ countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int64ToWord64Compat# w#))) + instance BitOps Int64 where +- (I64# x#) .&. (I64# y#) = I64# (x# `andI#` y#) +- (I64# x#) .|. (I64# y#) = I64# (x# `orI#` y#) +- (I64# x#) .^. (I64# y#) = I64# (x# `xorI#` y#) +- (I64# x#) .<<. (CountOf (I# w#)) = I64# (x# `iShiftL#` w#) +- (I64# x#) .>>. (CountOf (I# w#)) = I64# (x# `iShiftRL#` w#) ++ (I64# x#) .&. (I64# y#) = I64# (intToInt64Compat# (int64ToIntCompat# x# `andI#` int64ToIntCompat# y#)) ++ (I64# x#) .|. (I64# y#) = I64# (intToInt64Compat# (int64ToIntCompat# x# `orI#` int64ToIntCompat# y#)) ++ (I64# x#) .^. (I64# y#) = I64# (intToInt64Compat# (int64ToIntCompat# x# `xorI#` int64ToIntCompat# y#)) ++ (I64# x#) .<<. (CountOf (I# w#)) = I64# (intToInt64Compat# (int64ToIntCompat# x# `iShiftL#` w#)) ++ (I64# x#) .>>. (CountOf (I# w#)) = I64# (intToInt64Compat# (int64ToIntCompat# x# `iShiftRL#` w#)) + #else + instance FiniteBitsOps Int64 where + numberOfBits _ = 64 diff --git a/Basement/Cast.hs b/Basement/Cast.hs -index ecccba1..e8e9de2 100644 +index ecccba1..15cb205 100644 --- a/Basement/Cast.hs +++ b/Basement/Cast.hs @@ -18,6 +18,7 @@ module Basement.Cast @@ -439,8 +544,41 @@ index ecccba1..e8e9de2 100644 instance Cast Word64 Int64 where cast = word64ToInt64 instance Cast Word Int where +@@ -81,24 +82,24 @@ instance Cast Word Int where + + #if WORD_SIZE_IN_BITS == 64 + instance Cast Word Word64 where +- cast (W# w) = W64# w ++ cast (W# w) = W64# (wordToWord64Compat# w) + instance Cast Word64 Word where +- cast (W64# w) = W# w ++ cast (W64# w) = W# (word64ToWordCompat# w) + + instance Cast Word Int64 where +- cast (W# w) = I64# (word2Int# w) ++ cast (W# w) = I64# (intToInt64Compat# (word2Int# w)) + instance Cast Int64 Word where +- cast (I64# i) = W# (int2Word# i) ++ cast (I64# i) = W# (int2Word# (int64ToIntCompat# i)) + + instance Cast Int Int64 where +- cast (I# i) = I64# i ++ cast (I# i) = I64# (intToInt64Compat# i) + instance Cast Int64 Int where +- cast (I64# i) = I# i ++ cast (I64# i) = I# (int64ToIntCompat# i) + + instance Cast Int Word64 where +- cast (I# i) = W64# (int2Word# i) ++ cast (I# i) = W64# (wordToWord64Compat# (int2Word# i)) + instance Cast Word64 Int where +- cast (W64# w) = I# (word2Int# w) ++ cast (W64# w) = I# (word2Int# (word64ToWordCompat# w)) + #else + instance Cast Word Word32 where + cast (W# w) = W32# w diff --git a/Basement/From.hs b/Basement/From.hs -index 4f51154..be645d9 100644 +index 4f51154..0231ef1 100644 --- a/Basement/From.hs +++ b/Basement/From.hs @@ -1,3 +1,4 @@ @@ -584,13 +722,13 @@ index 4f51154..be645d9 100644 instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where - from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w)) -+ from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWord# w)) ++ from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWordCompat# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where - from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w)) -+ from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWord# w)) ++ from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWordCompat# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where - from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w)) -+ from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWord# w)) ++ from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWordCompat# w)) instance From (Zn64 n) Word64 where from = unZn64 instance From (Zn64 n) Word128 where @@ -599,22 +737,22 @@ index 4f51154..be645d9 100644 instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where - from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w)) -+ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWord# w)) ++ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWordCompat# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where - from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w)) -+ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWord# w)) ++ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWordCompat# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where - from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w)) -+ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWord# w)) ++ from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWordCompat# w)) instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where from = naturalToWord64 . unZn instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where diff --git a/Basement/HeadHackageUtils.hs b/Basement/HeadHackageUtils.hs new file mode 100644 -index 0000000..62fecde +index 0000000..324340e --- /dev/null +++ b/Basement/HeadHackageUtils.hs -@@ -0,0 +1,119 @@ +@@ -0,0 +1,199 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +module Basement.HeadHackageUtils where @@ -734,8 +872,88 @@ index 0000000..62fecde +narrow32WordCompat# :: Word# -> Word# +narrow32WordCompat# = narrow32Word# +#endif ++ ++#if __GLASGOW_HASKELL__ >= 903 ++and64Compat# :: Word64# -> Word64# -> Word64# ++and64Compat# = and64# ++ ++int64ToIntCompat# :: Int64# -> Int# ++int64ToIntCompat# = int64ToInt# ++ ++intToInt64Compat# :: Int# -> Int64# ++intToInt64Compat# = intToInt64# ++ ++int64ToWord64Compat# :: Int64# -> Word64# ++int64ToWord64Compat# = int64ToWord64# ++ ++or64Compat# :: Word64# -> Word64# -> Word64# ++or64Compat# = or64# ++ ++plusInt64Compat# :: Int64# -> Int64# -> Int64# ++plusInt64Compat# = plusInt64# ++ ++plusWord64Compat# :: Word64# -> Word64# -> Word64# ++plusWord64Compat# = plusWord64# ++ ++uncheckedShiftL64Compat# :: Word64# -> Int# -> Word64# ++uncheckedShiftL64Compat# = uncheckedShiftL64# ++ ++uncheckedShiftRL64Compat# :: Word64# -> Int# -> Word64# ++uncheckedShiftRL64Compat# = uncheckedShiftRL64# ++ ++word64ToInt64Compat# :: Word64# -> Int64# ++word64ToInt64Compat# = word64ToInt64# ++ ++word64ToWordCompat# :: Word64# -> Word# ++word64ToWordCompat# = word64ToWord# ++ ++wordToWord64Compat# :: Word# -> Word64# ++wordToWord64Compat# = wordToWord64# ++ ++xor64Compat# :: Word64# -> Word64# -> Word64# ++xor64Compat# = xor64# ++#else ++and64Compat# :: Word# -> Word# -> Word# ++and64Compat# = and# ++ ++int64ToIntCompat# :: Int# -> Int# ++int64ToIntCompat# x = x ++ ++intToInt64Compat# :: Int# -> Int# ++intToInt64Compat# x = x ++ ++int64ToWord64Compat# :: Int# -> Word# ++int64ToWord64Compat# = int2Word# ++ ++or64Compat# :: Word# -> Word# -> Word# ++or64Compat# = or# ++ ++plusInt64Compat# :: Int# -> Int# -> Int# ++plusInt64Compat# = (+#) ++ ++plusWord64Compat# :: Word# -> Word# -> Word# ++plusWord64Compat# = plusWord# ++ ++uncheckedShiftL64Compat# :: Word# -> Int# -> Word# ++uncheckedShiftL64Compat# = uncheckedShiftL# ++ ++uncheckedShiftRL64Compat# :: Word# -> Int# -> Word# ++uncheckedShiftRL64Compat# = uncheckedShiftRL# ++ ++word64ToInt64Compat# :: Word# -> Int# ++word64ToInt64Compat# = word2Int# ++ ++word64ToWordCompat# :: Word# -> Word# ++word64ToWordCompat# x = x ++ ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++ ++xor64Compat# :: Word# -> Word# -> Word# ++xor64Compat# = xor# ++#endif diff --git a/Basement/IntegralConv.hs b/Basement/IntegralConv.hs -index aff92b1..357bcdf 100644 +index aff92b1..9bd71f0 100644 --- a/Basement/IntegralConv.hs +++ b/Basement/IntegralConv.hs @@ -1,3 +1,4 @@ @@ -859,15 +1077,15 @@ index aff92b1..357bcdf 100644 instance IntegralDownsize Word64 Word8 where - integralDownsize (W64# i) = W8# (narrow8Word# (word64ToWord# i)) -+ integralDownsize (W64# i) = W8# (narrow8WordCompat# (word64ToWord# i)) ++ integralDownsize (W64# i) = W8# (narrow8WordCompat# (word64ToWordCompat# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word16 where - integralDownsize (W64# i) = W16# (narrow16Word# (word64ToWord# i)) -+ integralDownsize (W64# i) = W16# (narrow16WordCompat# (word64ToWord# i)) ++ integralDownsize (W64# i) = W16# (narrow16WordCompat# (word64ToWordCompat# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word32 where - integralDownsize (W64# i) = W32# (narrow32Word# (word64ToWord# i)) -+ integralDownsize (W64# i) = W32# (narrow32WordCompat# (word64ToWord# i)) ++ integralDownsize (W64# i) = W32# (narrow32WordCompat# (word64ToWordCompat# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word8 where @@ -899,7 +1117,7 @@ index aff92b1..357bcdf 100644 instance IntegralDownsize Integer Int8 where diff --git a/Basement/Numerical/Additive.hs b/Basement/Numerical/Additive.hs -index 7973887..1fd2091 100644 +index 7973887..d5c88b2 100644 --- a/Basement/Numerical/Additive.hs +++ b/Basement/Numerical/Additive.hs @@ -21,6 +21,7 @@ import GHC.Prim @@ -910,7 +1128,7 @@ index 7973887..1fd2091 100644 import Basement.Nat import Basement.Types.Word128 (Word128) import Basement.Types.Word256 (Word256) -@@ -65,15 +66,15 @@ instance Additive Int where +@@ -65,20 +66,20 @@ instance Additive Int where scale = scaleNum instance Additive Int8 where azero = 0 @@ -929,7 +1147,13 @@ index 7973887..1fd2091 100644 scale = scaleNum instance Additive Int64 where azero = 0 -@@ -93,15 +94,15 @@ instance Additive Natural where + #if WORD_SIZE_IN_BITS == 64 +- (I64# a) + (I64# b) = I64# (a +# b) ++ (I64# a) + (I64# b) = I64# (a `plusInt64Compat#` b) + #else + (I64# a) + (I64# b) = I64# (a `plusInt64#` b) + #endif +@@ -93,20 +94,20 @@ instance Additive Natural where scale = scaleNum instance Additive Word8 where azero = 0 @@ -948,8 +1172,14 @@ index 7973887..1fd2091 100644 scale = scaleNum instance Additive Word64 where azero = 0 + #if WORD_SIZE_IN_BITS == 64 +- (W64# a) + (W64# b) = W64# (a `plusWord#` b) ++ (W64# a) + (W64# b) = W64# (a `plusWord64Compat#` b) + #else + (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b)) + #endif diff --git a/Basement/Numerical/Conversion.hs b/Basement/Numerical/Conversion.hs -index a86d195..f967c34 100644 +index a86d195..71fbf93 100644 --- a/Basement/Numerical/Conversion.hs +++ b/Basement/Numerical/Conversion.hs @@ -18,8 +18,12 @@ module Basement.Numerical.Conversion @@ -965,12 +1195,61 @@ index a86d195..f967c34 100644 import GHC.Int import GHC.Word +@@ -29,42 +33,42 @@ import GHC.IntWord64 + + intToInt64 :: Int -> Int64 + #if WORD_SIZE_IN_BITS == 64 +-intToInt64 (I# i) = I64# i ++intToInt64 (I# i) = I64# (intToInt64Compat# i) + #else + intToInt64 (I# i) = I64# (intToInt64# i) + #endif + + int64ToInt :: Int64 -> Int + #if WORD_SIZE_IN_BITS == 64 +-int64ToInt (I64# i) = I# i ++int64ToInt (I64# i) = I# (int64ToIntCompat# i) + #else + int64ToInt (I64# i) = I# (int64ToInt# i) + #endif + + wordToWord64 :: Word -> Word64 + #if WORD_SIZE_IN_BITS == 64 +-wordToWord64 (W# i) = W64# i ++wordToWord64 (W# i) = W64# (wordToWord64Compat# i) + #else + wordToWord64 (W# i) = W64# (wordToWord64# i) + #endif + + word64ToWord :: Word64 -> Word + #if WORD_SIZE_IN_BITS == 64 +-word64ToWord (W64# i) = W# i ++word64ToWord (W64# i) = W# (word64ToWordCompat# i) + #else + word64ToWord (W64# i) = W# (word64ToWord# i) + #endif + + word64ToInt64 :: Word64 -> Int64 + #if WORD_SIZE_IN_BITS == 64 +-word64ToInt64 (W64# i) = I64# (word2Int# i) ++word64ToInt64 (W64# i) = I64# (word64ToInt64Compat# i) + #else + word64ToInt64 (W64# i) = I64# (word64ToInt64# i) + #endif + + int64ToWord64 :: Int64 -> Word64 + #if WORD_SIZE_IN_BITS == 64 +-int64ToWord64 (I64# i) = W64# (int2Word# i) ++int64ToWord64 (I64# i) = W64# (int64ToWord64Compat# i) + #else + int64ToWord64 (I64# i) = W64# (int64ToWord64# i) + #endif @@ -81,7 +85,7 @@ data Word32x2 = Word32x2 {-# UNPACK #-} !Word32 #if WORD_SIZE_IN_BITS == 64 word64ToWord32s :: Word64 -> Word32x2 -word64ToWord32s (W64# w64) = Word32x2 (W32# (uncheckedShiftRL# w64 32#)) (W32# (narrow32Word# w64)) -+word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32Compat# (uncheckedShiftRL# w64 32#))) (W32# (narrow32WordCompat# w64)) ++word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32Compat# (word64ToWordCompat# (uncheckedShiftRL64Compat# w64 32#)))) (W32# (narrow32WordCompat# (word64ToWordCompat# w64))) #else word64ToWord32s :: Word64 -> Word32x2 word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64)) @@ -1254,6 +1533,123 @@ index 756f255..3cdf130 100644 c7_LF :: Char7 c7_LF = Char7 0xa +diff --git a/Basement/Types/OffsetSize.hs b/Basement/Types/OffsetSize.hs +index 06b7d07..591e0a0 100644 +--- a/Basement/Types/OffsetSize.hs ++++ b/Basement/Types/OffsetSize.hs +@@ -57,6 +57,7 @@ import Data.Bits + import Basement.Compat.Base + import Basement.Compat.C.Types + import Basement.Compat.Semigroup ++import Basement.HeadHackageUtils + import Data.Proxy + import Basement.Numerical.Number + import Basement.Numerical.Additive +@@ -227,14 +228,14 @@ csizeOfSize :: CountOf Word8 -> CSize + #if WORD_SIZE_IN_BITS < 64 + csizeOfSize (CountOf (I# sz)) = CSize (W32# (int2Word# sz)) + #else +-csizeOfSize (CountOf (I# sz)) = CSize (W64# (int2Word# sz)) ++csizeOfSize (CountOf (I# sz)) = CSize (W64# (wordToWord64Compat# (int2Word# sz))) + #endif + + csizeOfOffset :: Offset8 -> CSize + #if WORD_SIZE_IN_BITS < 64 + csizeOfOffset (Offset (I# sz)) = CSize (W32# (int2Word# sz)) + #else +-csizeOfOffset (Offset (I# sz)) = CSize (W64# (int2Word# sz)) ++csizeOfOffset (Offset (I# sz)) = CSize (W64# (wordToWord64Compat# (int2Word# sz))) + #endif + + sizeOfCSSize :: CSsize -> CountOf Word8 +@@ -242,14 +243,14 @@ sizeOfCSSize (CSsize (-1)) = error "invalid size: CSSize is -1" + #if WORD_SIZE_IN_BITS < 64 + sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# sz) + #else +-sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# sz) ++sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# (int64ToIntCompat# sz)) + #endif + + sizeOfCSize :: CSize -> CountOf Word8 + #if WORD_SIZE_IN_BITS < 64 + sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# sz)) + #else +-sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# sz)) ++sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# (word64ToWordCompat# sz))) + #endif + + natValCountOf :: forall n ty proxy . (KnownNat n, NatWithinBound (CountOf ty) n) => proxy n -> CountOf ty +diff --git a/Basement/Types/Word128.hs b/Basement/Types/Word128.hs +index 13d68fa..0a1f038 100644 +--- a/Basement/Types/Word128.hs ++++ b/Basement/Types/Word128.hs +@@ -37,6 +37,7 @@ import Foreign.Storable + import Basement.Compat.Base + import Basement.Compat.Natural + import Basement.Compat.Primitive (bool#) ++import Basement.HeadHackageUtils + import Basement.Numerical.Conversion + import Basement.Numerical.Number + +@@ -128,10 +129,15 @@ instance Bits.Bits Word128 where + #if WORD_SIZE_IN_BITS < 64 + (+) = applyBiWordOnNatural (Prelude.+) + #else +-(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# s0) ++(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# carry, s0 #) = plusWord2# a0 b0 +- s1 = plusWord# (plusWord# a1 b1) carry ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ ++ !(# carry, s0 #) = plusWord2# a0' b0' ++ s1 = plusWord# (plusWord# a1' b1') carry + #endif + + -- temporary available until native operation available +diff --git a/Basement/Types/Word256.hs b/Basement/Types/Word256.hs +index 62ed727..7244d6b 100644 +--- a/Basement/Types/Word256.hs ++++ b/Basement/Types/Word256.hs +@@ -36,6 +36,7 @@ import Foreign.Storable + import Basement.Compat.Base + import Basement.Compat.Natural + import Basement.Compat.Primitive (bool#) ++import Basement.HeadHackageUtils + import Basement.Numerical.Conversion + import Basement.Numerical.Number + +@@ -149,12 +150,22 @@ instance Bits.Bits Word256 where + #else + (+) (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) ++ Word256 (W64# (wordToWord64Compat# s3)) (W64# (wordToWord64Compat# s2)) ++ (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# c0, s0 #) = plusWord2# a0 b0 +- !(# c1, s1 #) = plusWord3# a1 b1 c0 +- !(# c2, s2 #) = plusWord3# a2 b2 c1 +- !s3 = plusWord3NoCarry# a3 b3 c2 ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !a2' = word64ToWordCompat# a2 ++ !a3' = word64ToWordCompat# a3 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ !b2' = word64ToWordCompat# b2 ++ !b3' = word64ToWordCompat# b3 ++ ++ !(# c0, s0 #) = plusWord2# a0' b0' ++ !(# c1, s1 #) = plusWord3# a1' b1' c0 ++ !(# c2, s2 #) = plusWord3# a2' b2' c1 ++ !s3 = plusWord3NoCarry# a3' b3' c2 + + plusWord3NoCarry# a b c = plusWord# (plusWord# a b) c + plusWord3# a b c diff --git a/Basement/UArray.hs b/Basement/UArray.hs index 5d78a4e..63a320d 100644 --- a/Basement/UArray.hs diff --git a/patches/bytesmith-0.3.8.0.patch b/patches/bytesmith-0.3.8.0.patch index 10722c323bc4e96986d7ac15d65aa0fc9b1b6fdc..888b87b8c1ef4672db9f3d6ba6b7f67fd2d036e1 100644 --- a/patches/bytesmith-0.3.8.0.patch +++ b/patches/bytesmith-0.3.8.0.patch @@ -68,7 +68,7 @@ index a489a34..d9d6f08 100644 +wordToWord32Compat# x = x +#endif diff --git a/src/Data/Bytes/Parser/Latin.hs b/src/Data/Bytes/Parser/Latin.hs -index 462bbae..2f2e461 100644 +index 462bbae..73b8e55 100644 --- a/src/Data/Bytes/Parser/Latin.hs +++ b/src/Data/Bytes/Parser/Latin.hs @@ -1,5 +1,6 @@ @@ -87,6 +87,15 @@ index 462bbae..2f2e461 100644 let w = indexLatinCharArray (array c) (offset c) in if w >= '0' && w <= '9' then upcastUnitSuccess (skipDigitsAsciiLoop (Bytes.unsafeDrop 1 c)) +@@ -563,7 +564,7 @@ upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #) + upcastWord64Result :: Result# e Word# -> Result# e Word64 + {-# inline upcastWord64Result #-} + upcastWord64Result (# e | #) = (# e | #) +-upcastWord64Result (# | (# a, b, c #) #) = (# | (# W64# a, b, c #) #) ++upcastWord64Result (# | (# a, b, c #) #) = (# | (# W64# (wordToWord64Compat# a), b, c #) #) + + hexSmallWordMore :: + e -- Error message @@ -619,19 +620,19 @@ decWordStart e !chunk0 s0 = if length chunk0 > 0 upcastWord16Result :: Result# e Word# -> Result# e Word16 {-# inline upcastWord16Result #-} @@ -188,6 +197,15 @@ index 462bbae..2f2e461 100644 ) hexFixedWord32# :: e -> Parser e s Word# +@@ -1011,7 +1012,7 @@ hexFixedWord64 e = Parser + (\x s0 -> case runParser (hexFixedWord64# e) x s0 of + (# s1, r #) -> case r of + (# err | #) -> (# s1, (# err | #) #) +- (# | (# a, b, c #) #) -> (# s1, (# | (# W64# a, b, c #) #) #) ++ (# | (# a, b, c #) #) -> (# s1, (# | (# W64# (wordToWord64Compat# a), b, c #) #) #) + ) + + hexFixedWord64# :: e -> Parser e s Word# @@ -1020,7 +1021,7 @@ hexFixedWord64# e = uneffectfulWord# $ \chunk -> if length chunk >= 16 then let go !off !len !acc = case len of @@ -233,7 +251,7 @@ index 462bbae..2f2e461 100644 let !(# ca, r0 #) = Exts.timesWord2# a 10## !r1 = Exts.plusWord# r0 b !cb = int2Word# (ltWord# r1 r0) -@@ -1238,3 +1239,23 @@ peek' :: e -> Parser e s Char +@@ -1238,3 +1239,31 @@ peek' :: e -> Parser e s Char peek' e = uneffectful $ \(Bytes arr off len) -> if len > 0 then Success (indexCharArray arr off) off len else Failure e @@ -257,6 +275,14 @@ index 462bbae..2f2e461 100644 +wordToWord32Compat# :: Word# -> Word# +wordToWord32Compat# x = x +#endif ++ ++#if __GLASGOW_HASKELL__ >= 903 ++wordToWord64Compat# :: Word# -> Exts.Word64# ++wordToWord64Compat# = Exts.wordToWord64# ++#else ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++#endif diff --git a/src/Data/Bytes/Parser/Rebindable.hs b/src/Data/Bytes/Parser/Rebindable.hs index 3e04d0d..61f7c57 100644 --- a/src/Data/Bytes/Parser/Rebindable.hs diff --git a/patches/cborg-0.2.5.0.patch b/patches/cborg-0.2.5.0.patch deleted file mode 100644 index 255a903bca197792d37557645366f2e6dda6aef5..0000000000000000000000000000000000000000 --- a/patches/cborg-0.2.5.0.patch +++ /dev/null @@ -1,333 +0,0 @@ -diff --git a/src/Codec/CBOR/Decoding.hs b/src/Codec/CBOR/Decoding.hs -index 32e58ed..dcc320c 100644 ---- a/src/Codec/CBOR/Decoding.hs -+++ b/src/Codec/CBOR/Decoding.hs -@@ -358,21 +358,21 @@ decodeWord = Decoder (\k -> return (ConsumeWord (\w# -> k (W# w#)))) - -- - -- @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 (W8# (wordToWord8Compat# 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 (W16# (wordToWord16Compat# 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 (W32# (wordToWord32Compat# w#))))) - {-# INLINE decodeWord32 #-} - - -- | Decode a 'Word64'. -@@ -417,21 +417,21 @@ decodeInt = Decoder (\k -> return (ConsumeInt (\n# -> k (I# n#)))) - -- - -- @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 (I8# (intToInt8Compat# 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 (I16# (intToInt16Compat# 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 (I32# (intToInt32Compat# w#))))) - {-# INLINE decodeInt32 #-} - - -- | Decode an 'Int64'. -@@ -457,21 +457,21 @@ decodeWordCanonical = Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (W# - -- - -- @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 (W8# (wordToWord8Compat# 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 (W16# (wordToWord16Compat# 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 (W32# (wordToWord32Compat# w#))))) - {-# INLINE decodeWord32Canonical #-} - - -- | Decode canonical representation of a 'Word64'. -@@ -516,21 +516,21 @@ decodeIntCanonical = Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (I# n# - -- - -- @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 (I8# (intToInt8Compat# 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 (I16# (intToInt16Compat# 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 (I32# (intToInt32Compat# w#))))) - {-# INLINE decodeInt32Canonical #-} - - -- | Decode canonical representation of an 'Int64'. -@@ -759,7 +759,7 @@ decodeNull = Decoder (\k -> return (ConsumeNull (k ()))) - -- - -- @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 (W8# (wordToWord8Compat# w#))))) - {-# INLINE decodeSimple #-} - - -- | Decode canonical representation of an 'Integer'. -@@ -795,7 +795,7 @@ decodeDoubleCanonical = Decoder (\k -> return (ConsumeDoubleCanonical (\f# -> k - -- - -- @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 (W8# (wordToWord8Compat# w#))))) - {-# INLINE decodeSimpleCanonical #-} - - -------------------------------------------------------------- -@@ -998,3 +998,41 @@ decodeSequenceLenN f z g c get = - go !acc 0 = return $! g acc - go !acc n = do !x <- get; go (f acc x) (n-1) - {-# INLINE decodeSequenceLenN #-} -+ -+#if MIN_VERSION_base(4,16,0) -+intToInt8Compat# :: Int# -> Int8# -+intToInt8Compat# = intToInt8# -+ -+intToInt16Compat# :: Int# -> Int16# -+intToInt16Compat# = intToInt16# -+ -+intToInt32Compat# :: Int# -> Int32# -+intToInt32Compat# = intToInt32# -+ -+wordToWord8Compat# :: Word# -> Word8# -+wordToWord8Compat# = wordToWord8# -+ -+wordToWord16Compat# :: Word# -> Word16# -+wordToWord16Compat# = wordToWord16# -+ -+wordToWord32Compat# :: Word# -> Word32# -+wordToWord32Compat# = wordToWord32# -+#else -+intToInt8Compat# :: Int# -> Int# -+intToInt8Compat# x = x -+ -+intToInt16Compat# :: Int# -> Int# -+intToInt16Compat# x = x -+ -+intToInt32Compat# :: Int# -> Int# -+intToInt32Compat# x = x -+ -+wordToWord8Compat# :: Word# -> Word# -+wordToWord8Compat# x = x -+ -+wordToWord16Compat# :: Word# -> Word# -+wordToWord16Compat# x = x -+ -+wordToWord32Compat# :: Word# -> Word# -+wordToWord32Compat# x = x -+#endif -diff --git a/src/Codec/CBOR/FlatTerm.hs b/src/Codec/CBOR/FlatTerm.hs -index 36bd9aa..4d58f30 100644 ---- a/src/Codec/CBOR/FlatTerm.hs -+++ b/src/Codec/CBOR/FlatTerm.hs -@@ -57,6 +57,9 @@ import GHC.Exts (Word64#, Int64#) - #endif - import GHC.Word (Word(W#), Word8(W8#)) - import GHC.Exts (Int(I#), Int#, Word#, Float#, Double#) -+#if MIN_VERSION_base(4,16,0) -+import GHC.Exts (word8ToWord#) -+#endif - import GHC.Float (Float(F#), Double(D#), float2Double) - - import Data.Word -@@ -714,7 +717,12 @@ unW# :: Word -> Word# - unW# (W# w#) = w# - - unW8# :: Word8 -> Word# --unW8# (W8# w#) = w# -+unW8# (W8# w#) = -+#if MIN_VERSION_base(4,16,0) -+ word8ToWord# w# -+#else -+ w# -+#endif - - unF# :: Float -> Float# - unF# (F# f#) = f# -diff --git a/src/Codec/CBOR/Magic.hs b/src/Codec/CBOR/Magic.hs -index 3e38373..42cfb3f 100644 ---- a/src/Codec/CBOR/Magic.hs -+++ b/src/Codec/CBOR/Magic.hs -@@ -150,8 +150,8 @@ grabWord8 (Ptr ip#) = W8# (indexWord8OffAddr# ip# 0#) - -- On x86 machines with GHC 7.10, we have byteswap primitives - -- available to make this conversion very fast. - --grabWord16 (Ptr ip#) = W16# (narrow16Word# (byteSwap16# (indexWord16OffAddr# ip# 0#))) --grabWord32 (Ptr ip#) = W32# (narrow32Word# (byteSwap32# (indexWord32OffAddr# ip# 0#))) -+grabWord16 (Ptr ip#) = W16# (wordToWord16Compat# (narrow16Word# (byteSwap16# (word16ToWordCompat# (indexWord16OffAddr# ip# 0#))))) -+grabWord32 (Ptr ip#) = W32# (wordToWord32Compat# (narrow32Word# (byteSwap32# (word32ToWordCompat# (indexWord32OffAddr# ip# 0#))))) - #if defined(ARCH_64bit) - grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#)) - #else -@@ -388,9 +388,9 @@ intToInt64 :: Int -> Int64 - intToInt64 = fromIntegral - {-# INLINE intToInt64 #-} - --word8ToWord (W8# w#) = W# w# --word16ToWord (W16# w#) = W# w# --word32ToWord (W32# w#) = W# w# -+word8ToWord (W8# w#) = W# (word8ToWordCompat# w#) -+word16ToWord (W16# w#) = W# (word16ToWordCompat# w#) -+word32ToWord (W32# w#) = W# (word32ToWordCompat# w#) - #if defined(ARCH_64bit) - word64ToWord (W64# w#) = W# w# - #else -@@ -405,11 +405,11 @@ word64ToWord (W64# w64#) = - {-# INLINE word32ToWord #-} - {-# INLINE word64ToWord #-} - --word8ToInt (W8# w#) = I# (word2Int# w#) --word16ToInt (W16# w#) = I# (word2Int# w#) -+word8ToInt (W8# w#) = I# (word2Int# (word8ToWordCompat# w#)) -+word16ToInt (W16# w#) = I# (word2Int# (word16ToWordCompat# w#)) - - #if defined(ARCH_64bit) --word32ToInt (W32# w#) = I# (word2Int# w#) -+word32ToInt (W32# w#) = I# (word2Int# (word32ToWordCompat# w#)) - #else - word32ToInt (W32# w#) = - case isTrue# (w# `ltWord#` 0x80000000##) of -@@ -598,3 +598,35 @@ copyByteArrayToPtr (ByteArray ba#) (I# off#) (Ptr addr#) (I# len#) = - IO (\s -> - case copyByteArrayToAddr# ba# off# addr# len# s of - s' -> (# s', () #)) -+ -+#if MIN_VERSION_base(4,16,0) -+word8ToWordCompat# :: Word8# -> Word# -+word8ToWordCompat# = word8ToWord# -+ -+word16ToWordCompat# :: Word16# -> Word# -+word16ToWordCompat# = word16ToWord# -+ -+word32ToWordCompat# :: Word32# -> Word# -+word32ToWordCompat# = word32ToWord# -+ -+wordToWord16Compat# :: Word# -> Word16# -+wordToWord16Compat# = wordToWord16# -+ -+wordToWord32Compat# :: Word# -> Word32# -+wordToWord32Compat# = wordToWord32# -+#else -+word8ToWordCompat# :: Word# -> Word# -+word8ToWordCompat# x = x -+ -+word16ToWordCompat# :: Word# -> Word# -+word16ToWordCompat# x = x -+ -+word32ToWordCompat# :: Word# -> Word# -+word32ToWordCompat# x = x -+ -+wordToWord16Compat# :: Word# -> Word# -+wordToWord16Compat# x = x -+ -+wordToWord32Compat# :: Word# -> Word# -+wordToWord32Compat# x = x -+#endif -diff --git a/src/Codec/CBOR/Read.hs b/src/Codec/CBOR/Read.hs -index cf13270..fa35507 100644 ---- a/src/Codec/CBOR/Read.hs -+++ b/src/Codec/CBOR/Read.hs -@@ -1773,13 +1773,13 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of - - 0x18 -> let !w@(W8# w#) = eatTailWord8 bs - sz = 2 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word8ToWordCompat# w#)) $! toInteger w) - 0x19 -> let !w@(W16# w#) = eatTailWord16 bs - sz = 3 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word16ToWordCompat# w#)) $! toInteger w) - 0x1a -> let !w@(W32# w#) = eatTailWord32 bs - sz = 5 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! toInteger w) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word32ToWordCompat# w#)) $! toInteger w) - 0x1b -> let !w@(W64# w#) = eatTailWord64 bs - sz = 9 - #if defined(ARCH_32bit) -@@ -1815,13 +1815,13 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of - 0x37 -> DecodedToken 1 (BigIntToken True (-24)) - 0x38 -> let !w@(W8# w#) = eatTailWord8 bs - sz = 2 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w)) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word8ToWordCompat# w#)) $! (-1 - toInteger w)) - 0x39 -> let !w@(W16# w#) = eatTailWord16 bs - sz = 3 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w)) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word16ToWordCompat# w#)) $! (-1 - toInteger w)) - 0x3a -> let !w@(W32# w#) = eatTailWord32 bs - sz = 5 -- in DecodedToken sz (BigIntToken (isWordCanonical sz w#) $! (-1 - toInteger w)) -+ in DecodedToken sz (BigIntToken (isWordCanonical sz (word32ToWordCompat# w#)) $! (-1 - toInteger w)) - 0x3b -> let !w@(W64# w#) = eatTailWord64 bs - sz = 9 - #if defined(ARCH_32bit) -@@ -2692,3 +2692,23 @@ readBigNInt bs - -- representation for the number in question). - isBigIntRepCanonical :: ByteString -> Bool - isBigIntRepCanonical bstr = BS.length bstr > 8 && BS.unsafeHead bstr /= 0x00 -+ -+#if MIN_VERSION_base(4,16,0) -+word8ToWordCompat# :: Word8# -> Word# -+word8ToWordCompat# = word8ToWord# -+ -+word16ToWordCompat# :: Word16# -> Word# -+word16ToWordCompat# = word16ToWord# -+ -+word32ToWordCompat# :: Word32# -> Word# -+word32ToWordCompat# = word32ToWord# -+#else -+word8ToWordCompat# :: Word# -> Word# -+word8ToWordCompat# x = x -+ -+word16ToWordCompat# :: Word# -> Word# -+word16ToWordCompat# x = x -+ -+word32ToWordCompat# :: Word# -> Word# -+word32ToWordCompat# x = x -+#endif diff --git a/patches/cborg-0.2.6.0.patch b/patches/cborg-0.2.6.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..db39c1aab8e539e34f593dca725cbf1ec9a871c0 --- /dev/null +++ b/patches/cborg-0.2.6.0.patch @@ -0,0 +1,153 @@ +diff --git a/src/Codec/CBOR/Decoding.hs b/src/Codec/CBOR/Decoding.hs +index 2d18e51..ff9ee02 100644 +--- a/src/Codec/CBOR/Decoding.hs ++++ b/src/Codec/CBOR/Decoding.hs +@@ -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 __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) + | PeekByteOffset (Int64# -> ST s (DecodeAction s a)) + #else + | PeekByteOffset (Int# -> ST s (DecodeAction s a)) +@@ -327,12 +327,12 @@ 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 ++#if __GLASGOW_HASKELL__ >= 903 || WORD_SIZE_IN_BITS == 32 + toInt64 n = I64# (intToInt64# n) + toWord64 n = W64# (wordToWord64# n) ++#else ++toInt64 n = I64# n ++toWord64 n = W64# n + #endif + #else + toInt8 n = I8# n +@@ -748,7 +748,7 @@ decodeTag64 :: Decoder s Word64 + {-# INLINE decodeTag64 #-} + decodeTag64 = + #if defined(ARCH_64bit) +- Decoder (\k -> return (ConsumeTag (\w# -> k (W64# w#)))) ++ Decoder (\k -> return (ConsumeTag (\w# -> k (toWord64 w#)))) + #else + Decoder (\k -> return (ConsumeTag64 (\w64# -> k (W64# w64#)))) + #endif +@@ -769,7 +769,7 @@ decodeTag64Canonical :: Decoder s Word64 + {-# INLINE decodeTag64Canonical #-} + decodeTag64Canonical = + #if defined(ARCH_64bit) +- Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W64# w#)))) ++ Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (toWord64 w#)))) + #else + Decoder (\k -> return (ConsumeTag64Canonical (\w64# -> k (W64# w64#)))) + #endif +diff --git a/src/Codec/CBOR/FlatTerm.hs b/src/Codec/CBOR/FlatTerm.hs +index 9d8b20a..efa1cb7 100644 +--- a/src/Codec/CBOR/FlatTerm.hs ++++ b/src/Codec/CBOR/FlatTerm.hs +@@ -50,10 +50,13 @@ import qualified Codec.CBOR.ByteArray as BA + import qualified Codec.CBOR.ByteArray.Sliced as BAS + + import Data.Int +-#if defined(ARCH_32bit) ++#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH32_bit) + import GHC.Int (Int64(I64#)) ++import GHC.Exts (Int64#) ++#endif ++#if defined(ARCH32_bit) + import GHC.Word (Word64(W64#)) +-import GHC.Exts (Word64#, Int64#) ++import GHC.Exts (Word64#) + #endif + #if MIN_VERSION_ghc_prim(0,8,0) + import GHC.Exts (word8ToWord#) +@@ -456,7 +459,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 __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) + go ts (PeekByteOffset k)= k (unI64# 0) >>= go ts + #else + go ts (PeekByteOffset k)= k 0# >>= go ts +@@ -732,7 +735,9 @@ unD# (D# f#) = f# + #if defined(ARCH_32bit) + unW64# :: Word64 -> Word64# + unW64# (W64# w#) = w# ++#endif + ++#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) + unI64# :: Int64 -> Int64# + unI64# (I64# i#) = i# + #endif +diff --git a/src/Codec/CBOR/Magic.hs b/src/Codec/CBOR/Magic.hs +index 019f618..2a65ce2 100644 +--- a/src/Codec/CBOR/Magic.hs ++++ b/src/Codec/CBOR/Magic.hs +@@ -166,7 +166,9 @@ 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 __GLASGOW_HASKELL__ >= 903 ++grabWord64 (Ptr ip#) = W64# (byteSwap64# (indexWord64OffAddr# ip# 0#)) ++#elif defined(ARCH_64bit) + grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#)) + #else + grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#))) +@@ -418,13 +420,10 @@ int64ToWord64 = fromIntegral + 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# ++#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) ++word64ToWord (W64# w64#) = W# (word64ToWord# w64#) + #else +-word64ToWord (W64# w64#) = +- case isTrue# (w64# `leWord64#` wordToWord64# 0xffffffff##) of +- True -> Just (W# (word64ToWord# w64#)) +- False -> Nothing ++word64ToWord (W64# w#) = W# w# + #endif + #else + word8ToWord (W8# w#) = W# w# +@@ -470,15 +469,15 @@ word32ToInt (W32# w#) = + #endif + #endif + +-#if defined(ARCH_64bit) ++#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) + word64ToInt (W64# w#) = +- case isTrue# (w# `ltWord#` 0x8000000000000000##) of +- True -> Just (I# (word2Int# w#)) ++ case isTrue# (w# `ltWord64#` wordToWord64# 0x80000000##) of ++ True -> Just (I# (int64ToInt# (word64ToInt64# w#))) + False -> Nothing + #else + word64ToInt (W64# w#) = +- case isTrue# (w# `ltWord64#` wordToWord64# 0x80000000##) of +- True -> Just (I# (int64ToInt# (word64ToInt64# w#))) ++ case isTrue# (w# `ltWord#` 0x8000000000000000##) of ++ True -> Just (I# (word2Int# w#)) + False -> Nothing + #endif + +diff --git a/src/Codec/CBOR/Read.hs b/src/Codec/CBOR/Read.hs +index 0dbb0b6..4d63bba 100644 +--- a/src/Codec/CBOR/Read.hs ++++ b/src/Codec/CBOR/Read.hs +@@ -247,7 +247,7 @@ data SlowPath s a + | SlowConsumeTokenByteArray {-# UNPACK #-} !ByteString (BA.ByteArray -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int + | SlowConsumeTokenString {-# UNPACK #-} !ByteString (T.Text -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int + | SlowConsumeTokenUtf8ByteArray {-# UNPACK #-} !ByteString (BA.ByteArray -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int +-#if defined(ARCH_32bit) ++#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) + | SlowPeekByteOffset {-# UNPACK #-} !ByteString (Int64# -> ST s (DecodeAction s a)) + #else + | SlowPeekByteOffset {-# UNPACK #-} !ByteString (Int# -> ST s (DecodeAction s a)) diff --git a/patches/cereal-0.5.8.1.patch b/patches/cereal-0.5.8.1.patch deleted file mode 100644 index 818d7ef0f27b3a92df426d654806515fec510ed8..0000000000000000000000000000000000000000 --- a/patches/cereal-0.5.8.1.patch +++ /dev/null @@ -1,47 +0,0 @@ -diff --git a/src/Data/Serialize/Get.hs b/src/Data/Serialize/Get.hs -index fcda52d..4ce7387 100644 ---- a/src/Data/Serialize/Get.hs -+++ b/src/Data/Serialize/Get.hs -@@ -723,8 +723,8 @@ shiftl_w32 :: Word32 -> Int -> Word32 - shiftl_w64 :: Word64 -> Int -> Word64 - - #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) --shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i) --shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i) -+shiftl_w16 (W16# w) (I# i) = W16# (wordToWord16Compat# (word16ToWordCompat# w `uncheckedShiftL#` i)) -+shiftl_w32 (W32# w) (I# i) = W32# (wordToWord32Compat# (word32ToWordCompat# w `uncheckedShiftL#` i)) - - #if WORD_SIZE_IN_BITS < 64 - shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i) -@@ -745,6 +745,31 @@ shiftl_w32 = shiftL - shiftl_w64 = shiftL - #endif - -+#if MIN_VERSION_base(4,16,0) -+word16ToWordCompat# :: Word16# -> Word# -+word16ToWordCompat# = word16ToWord# -+ -+word32ToWordCompat# :: Word32# -> Word# -+word32ToWordCompat# = word32ToWord# -+ -+wordToWord16Compat# :: Word# -> Word16# -+wordToWord16Compat# = wordToWord16# -+ -+wordToWord32Compat# :: Word# -> Word32# -+wordToWord32Compat# = wordToWord32# -+#else -+word16ToWordCompat# :: Word# -> Word# -+word16ToWordCompat# x = x -+ -+word32ToWordCompat# :: Word# -> Word# -+word32ToWordCompat# x = x -+ -+wordToWord16Compat# :: Word# -> Word# -+wordToWord16Compat# x = x -+ -+wordToWord32Compat# :: Word# -> Word# -+wordToWord32Compat# x = x -+#endif - - -- Containers ------------------------------------------------------------------ - diff --git a/patches/cereal-0.5.8.2.patch b/patches/cereal-0.5.8.2.patch new file mode 100644 index 0000000000000000000000000000000000000000..13a780e4d64dd0cf65c58f684eca65c364fbe98e --- /dev/null +++ b/patches/cereal-0.5.8.2.patch @@ -0,0 +1,16 @@ +diff --git a/src/Data/Serialize/Get.hs b/src/Data/Serialize/Get.hs +index 87fd159..c08ee3e 100644 +--- a/src/Data/Serialize/Get.hs ++++ b/src/Data/Serialize/Get.hs +@@ -741,7 +741,11 @@ foreign import ccall unsafe "stg_uncheckedShiftL64" + #endif + + #else ++# if __GLASGOW_HASKELL__ >= 903 ++shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i) ++# else + shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i) ++# endif + #endif + + #else diff --git a/patches/data-bword-0.1.0.1.patch b/patches/data-bword-0.1.0.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..927d0c2805ae15acd760382b30ae6b3bd1ee1f54 --- /dev/null +++ b/patches/data-bword-0.1.0.1.patch @@ -0,0 +1,61 @@ +diff --git a/src/Data/BinaryWord.hs b/src/Data/BinaryWord.hs +index f2f4d40..a962bc4 100644 +--- a/src/Data/BinaryWord.hs ++++ b/src/Data/BinaryWord.hs +@@ -29,6 +29,10 @@ import GHC.Word (Word32(..)) + # endif + # if WORD_SIZE_IN_BITS == 64 + import GHC.Word (Word64(..)) ++import GHC.Exts (Word#) ++# if __GLASGOW_HASKELL__ >= 903 ++import GHC.Exts (Word64#, wordToWord64#, word64ToWord#) ++# endif + # endif + #endif + +@@ -290,9 +294,9 @@ instance BinaryWord Word64 where + {-# INLINE signedWord #-} + #if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64 + unwrappedAdd (W64# x) (W64# y) = hi `seq` lo `seq` (hi, lo) +- where (# hi', lo' #) = plusWord2# x y +- lo = W64# lo' +- hi = W64# hi' ++ where (# hi', lo' #) = plusWord2# (word64ToWordCompat# x) (word64ToWordCompat# y) ++ lo = W64# (wordToWord64Compat# lo') ++ hi = W64# (wordToWord64Compat# hi') + {-# INLINE unwrappedAdd #-} + #else + unwrappedAdd x y = hi `seq` lo `seq` (hi, lo) +@@ -302,9 +306,9 @@ instance BinaryWord Word64 where + #endif + #if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64 + unwrappedMul (W64# x) (W64# y) = hi `seq` lo `seq` (hi, lo) +- where (# hi', lo' #) = timesWord2# x y +- lo = W64# lo' +- hi = W64# hi' ++ where (# hi', lo' #) = timesWord2# (word64ToWordCompat# x) (word64ToWordCompat# y) ++ lo = W64# (wordToWord64Compat# lo') ++ hi = W64# (wordToWord64Compat# hi') + {-# INLINE unwrappedMul #-} + #else + unwrappedMul x y = hi `seq` lo `seq` (hi, lo) +@@ -541,3 +545,19 @@ instance BinaryWord Int64 where + {-# INLINE setMsb #-} + clearMsb x = clearBit x 63 + {-# INLINE clearMsb #-} ++ ++#if WORD_SIZE_IN_BITS == 64 ++# if __GLASGOW_HASKELL__ >= 903 ++wordToWord64Compat# :: Word# -> Word64# ++wordToWord64Compat# = wordToWord64# ++ ++word64ToWordCompat# :: Word64# -> Word# ++word64ToWordCompat# = word64ToWord# ++# else ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++ ++word64ToWordCompat# :: Word# -> Word# ++word64ToWordCompat# x = x ++# endif ++#endif diff --git a/patches/memory-0.16.0.patch b/patches/memory-0.16.0.patch index 8f091fb773b850beb1973f420f23a2a40aacf78d..0ceea80788b1f5b0ba4e888fc8e9dbb4ec4bf352 100644 --- a/patches/memory-0.16.0.patch +++ b/patches/memory-0.16.0.patch @@ -393,16 +393,18 @@ index 0000000..d6ab707 +narrow32WordCompat# = narrow32Word# +#endif diff --git a/Data/Memory/Internal/CompatPrim64.hs b/Data/Memory/Internal/CompatPrim64.hs -index b6d2bd7..5a98617 100644 +index b6d2bd7..c16a9dd 100644 --- a/Data/Memory/Internal/CompatPrim64.hs +++ b/Data/Memory/Internal/CompatPrim64.hs -@@ -52,7 +52,37 @@ module Data.Memory.Internal.CompatPrim64 +@@ -52,8 +52,44 @@ module Data.Memory.Internal.CompatPrim64 #if WORD_SIZE_IN_BITS == 64 -import GHC.Prim hiding (Word64#, Int64#) -+import GHC.Prim hiding ( Word64#, Int64# +#if __GLASGOW_HASKELL__ >= 903 ++import GHC.Prim ++#else ++import GHC.Prim hiding ( Word64#, Int64# + , eqInt64# + , neInt64# + , ltInt64# @@ -430,11 +432,24 @@ index b6d2bd7..5a98617 100644 + , int64ToInt# + , wordToWord64# + , word64ToWord# -+#endif + ) ++#endif ++#if __GLASGOW_HASKELL__ >= 903 ++w64# :: Word# -> Word# -> Word# -> Word64# ++w64# w _ _ = wordToWord64# w ++#else #if __GLASGOW_HASKELL__ >= 708 type OutBool = Int# + #else +@@ -146,6 +182,7 @@ timesWord64# = timesWord# + + w64# :: Word# -> Word# -> Word# -> Word64# + w64# w _ _ = w ++#endif + + #elif WORD_SIZE_IN_BITS == 32 + import GHC.IntWord64 diff --git a/memory.cabal b/memory.cabal index 2db3f39..eec3b16 100644 --- a/memory.cabal diff --git a/patches/primitive-0.7.3.0.patch b/patches/primitive-0.7.3.0.patch new file mode 100644 index 0000000000000000000000000000000000000000..cdc501728619bed20aa8b884042bf70dba1dbb8f --- /dev/null +++ b/patches/primitive-0.7.3.0.patch @@ -0,0 +1,13 @@ +diff --git a/Data/Primitive/MachDeps.hs b/Data/Primitive/MachDeps.hs +index 3033e23..a702a3d 100644 +--- a/Data/Primitive/MachDeps.hs ++++ b/Data/Primitive/MachDeps.hs +@@ -113,7 +113,7 @@ aLIGNMENT_INT64 = ALIGNMENT_INT64 + sIZEOF_WORD64 = SIZEOF_WORD64 + aLIGNMENT_WORD64 = ALIGNMENT_WORD64 + +-#if WORD_SIZE_IN_BITS == 32 ++#if __GLASGOW_HASKELL__ >= 903 || WORD_SIZE_IN_BITS == 32 + type Word64_# = Word64# + type Int64_# = Int64# + #else diff --git a/patches/primitive-unaligned-0.1.1.1.patch b/patches/primitive-unaligned-0.1.1.1.patch new file mode 100644 index 0000000000000000000000000000000000000000..150d4056036453037c40e4513e64f6e5ebee6c49 --- /dev/null +++ b/patches/primitive-unaligned-0.1.1.1.patch @@ -0,0 +1,90 @@ +diff --git a/src-64/Data/Primitive/Unaligned/Mach.hs b/src-64/Data/Primitive/Unaligned/Mach.hs +index f365f40..2eead89 100644 +--- a/src-64/Data/Primitive/Unaligned/Mach.hs ++++ b/src-64/Data/Primitive/Unaligned/Mach.hs +@@ -1,3 +1,4 @@ ++{-# language CPP #-} + {-# language MagicHash #-} + {-# language UnboxedTuples #-} + +@@ -17,11 +18,23 @@ import qualified GHC.Exts as E + + indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64 + indexUnalignedWord64Array# a i = +- W64# (E.indexWord8ArrayAsWord# a i) ++ W64# ( ++#if __GLASGOW_HASKELL__ >= 903 ++ E.indexWord8ArrayAsWord64# ++#else ++ E.indexWord8ArrayAsWord# ++#endif ++ a i) + + indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64 + indexUnalignedInt64Array# a i = +- I64# (E.indexWord8ArrayAsInt# a i) ++ I64# ( ++#if __GLASGOW_HASKELL__ >= 903 ++ E.indexWord8ArrayAsInt64# ++#else ++ E.indexWord8ArrayAsInt# ++#endif ++ a i) + + readUnalignedWord64Array# :: + MutableByteArray# s +@@ -29,7 +42,13 @@ readUnalignedWord64Array# :: + -> State# s + -> (# State# s, Word64 #) + readUnalignedWord64Array# a i s0 = +- case E.readWord8ArrayAsWord# a i s0 of ++ case ++#if __GLASGOW_HASKELL__ >= 903 ++ E.readWord8ArrayAsWord64# ++#else ++ E.readWord8ArrayAsWord# ++#endif ++ a i s0 of + (# s1, r #) -> (# s1, W64# r #) + + readUnalignedInt64Array# :: +@@ -38,7 +57,13 @@ readUnalignedInt64Array# :: + -> State# s + -> (# State# s, Int64 #) + readUnalignedInt64Array# a i s0 = +- case E.readWord8ArrayAsInt# a i s0 of ++ case ++#if __GLASGOW_HASKELL__ >= 903 ++ E.readWord8ArrayAsInt64# ++#else ++ E.readWord8ArrayAsInt# ++#endif ++ a i s0 of + (# s1, r #) -> (# s1, I64# r #) + + writeUnalignedWord64Array# :: +@@ -48,7 +73,12 @@ writeUnalignedWord64Array# :: + -> State# s + -> State# s + writeUnalignedWord64Array# a i (W64# w) = +- E.writeWord8ArrayAsWord# a i w ++#if __GLASGOW_HASKELL__ >= 903 ++ E.writeWord8ArrayAsWord64# ++#else ++ E.writeWord8ArrayAsWord# ++#endif ++ a i w + + writeUnalignedInt64Array# :: + MutableByteArray# s +@@ -57,4 +87,9 @@ writeUnalignedInt64Array# :: + -> State# s + -> State# s + writeUnalignedInt64Array# a i (I64# w) = +- E.writeWord8ArrayAsInt# a i w ++#if __GLASGOW_HASKELL__ >= 903 ++ E.writeWord8ArrayAsInt64# ++#else ++ E.writeWord8ArrayAsInt# ++#endif ++ a i w diff --git a/patches/proto3-wire-1.2.2.patch b/patches/proto3-wire-1.2.2.patch index e2b7c6a733bed0473f88ba33102783c566819ab4..fa716d18e75eaef48ff4956994c9ec5cd7dad441 100644 --- a/patches/proto3-wire-1.2.2.patch +++ b/patches/proto3-wire-1.2.2.patch @@ -1,19 +1,42 @@ diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs -index 3113baa..31deb68 100644 +index 3113baa..aa467bb 100644 --- a/src/Proto3/Wire/Reverse/Prim.hs +++ b/src/Proto3/Wire/Reverse/Prim.hs -@@ -116,6 +116,10 @@ import GHC.Exts ( Addr#, Int#, Proxy#, +@@ -111,11 +111,18 @@ import Data.Word ( Word16, + byteSwap16, byteSwap32, + byteSwap64 ) + import Foreign ( Storable(..) ) +-import GHC.Exts ( Addr#, Int#, Proxy#, ++import GHC.Exts ( Addr#, Int#, Proxy#, Word#, + RealWorld, State#, (+#), and#, inline, or#, plusAddr#, plusWord#, proxy#, uncheckedShiftRL# ) +#if MIN_VERSION_base(4,16,0) +import GHC.Exts ( Word8#, Word32#, + word32ToWord#, wordToWord8# ) ++#endif ++#if __GLASGOW_HASKELL__ >= 903 ++import GHC.Exts ( wordToWord64# ) +#endif import GHC.IO ( IO(..) ) import GHC.Int ( Int(..) ) import GHC.Ptr ( Ptr(..) ) -@@ -663,7 +667,7 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x +@@ -137,11 +144,10 @@ import Proto3.Wire.Reverse.Width ( AssocPlusNat(..), + + -- "ghc-prim" v0.6.1 defines `GHC.Prim.Ext.WORD64`, but we do not wish + -- to require that version of "ghc-prim". Therefore we define it locally. +-#if WORD_SIZE_IN_BITS < 64 +-import GHC.IntWord64 (Word64#) ++#if __GLASGOW_HASKELL__ >= 903 || WORD_SIZE_IN_BITS < 64 ++import GHC.Exts (Word64#) + type WORD64 = Word64# + #else +-import GHC.Exts (Word#) + type WORD64 = Word# + #endif + +@@ -663,7 +669,7 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x Word# -> FixedPrim (n + 1) lsb = \p x -> p (uncheckedShiftRL# x 6#) &<> @@ -22,7 +45,7 @@ index 3113baa..31deb68 100644 {-# INLINE lsb #-} p1 :: Word# -> FixedPrim 1 -@@ -671,10 +675,10 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x +@@ -671,10 +677,10 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x p3 :: Word# -> FixedPrim 3 p4 :: Word# -> FixedPrim 4 @@ -37,7 +60,31 @@ index 3113baa..31deb68 100644 {-# INLINE p1 #-} {-# INLINE p2 #-} -@@ -719,7 +723,7 @@ word32Base128LEVar_inline = \(W32# x0) -> +@@ -684,7 +690,10 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x + + -- | The bounded primitive implementing + -- `Proto3.Wire.Reverse.wordBase128LEVar`. +-#if WORD_SIZE_IN_BITS < 64 ++#if __GLASGOW_HASKELL__ >= 903 ++wordBase128LEVar :: Word -> BoundedPrim 10 ++wordBase128LEVar (W# w) = word64Base128LEVar (W64# (wordToWord64# w)) ++#elif WORD_SIZE_IN_BITS < 64 + wordBase128LEVar :: Word -> BoundedPrim 5 + wordBase128LEVar (W# w) = word32Base128LEVar (W32# w) + #else +@@ -695,7 +704,10 @@ wordBase128LEVar (W# w) = word64Base128LEVar (W64# w) + + -- | Like 'wordBase128LEVar' but inlined, possibly bloating your code. On + -- the other hand, inlining an application to a constant may shrink your code. +-#if WORD_SIZE_IN_BITS < 64 ++#if __GLASGOW_HASKELL__ >= 903 ++wordBase128LEVar_inline :: Word -> BoundedPrim 10 ++wordBase128LEVar_inline (W# w) = word64Base128LEVar_inline (W64# (wordToWord64# w)) ++#elif WORD_SIZE_IN_BITS < 64 + wordBase128LEVar_inline :: Word -> BoundedPrim 5 + wordBase128LEVar_inline (W# w) = word32Base128LEVar_inline (W32# w) + #else +@@ -719,7 +731,7 @@ word32Base128LEVar_inline = \(W32# x0) -> wordBase128LEVar_choose 3 wordBase128LE_p3 $ wordBase128LEVar_choose 4 wordBase128LE_p4 $ (\x -> liftFixedPrim (wordBase128LE_p5 0## x)) @@ -46,7 +93,7 @@ index 3113baa..31deb68 100644 {-# INLINE word32Base128LEVar_inline #-} wordBase128LEVar_choose :: -@@ -742,13 +746,13 @@ wordBase128LE_msb :: +@@ -742,13 +754,13 @@ wordBase128LE_msb :: (Word# -> Word# -> FixedPrim n) -> Word# -> Word# -> FixedPrim (n + 1) wordBase128LE_msb = \p m x -> @@ -62,7 +109,7 @@ index 3113baa..31deb68 100644 {-# INLINE wordBase128LE_p1 #-} wordBase128LE_p2 :: Word# -> Word# -> FixedPrim 2 -@@ -813,10 +817,10 @@ word64Base128LEVar_big x = pif (W64# x <= shiftL 1 60 - 1) p60 p64 +@@ -813,10 +825,10 @@ word64Base128LEVar_big x = pif (W64# x <= shiftL 1 60 - 1) p60 p64 word32Base128LEVar (W32# (shR 28)) p64 = ( liftFixedPrim (word28Base128LE x32) &<> @@ -76,7 +123,7 @@ index 3113baa..31deb68 100644 shR s = case fromIntegral (shiftR (W64# x) s) of W32# y -> y {-# NOINLINE word64Base128LEVar_big #-} -@@ -836,3 +840,17 @@ vectorFixedPrim f = etaBuildR $ \v -> +@@ -836,3 +848,17 @@ vectorFixedPrim f = etaBuildR $ \v -> where w = fromInteger (natVal' (proxy# :: Proxy# w)) {-# INLINE vectorFixedPrim #-} diff --git a/patches/wide-word-0.1.1.2.patch b/patches/wide-word-0.1.1.2.patch new file mode 100644 index 0000000000000000000000000000000000000000..ecbf73f15dd2888033e3077aab63e4a99b655328 --- /dev/null +++ b/patches/wide-word-0.1.1.2.patch @@ -0,0 +1,609 @@ +diff --git a/src/Data/WideWord/Int128.hs b/src/Data/WideWord/Int128.hs +index 0eca4ca..5739b38 100644 +--- a/src/Data/WideWord/Int128.hs ++++ b/src/Data/WideWord/Int128.hs +@@ -48,10 +48,15 @@ import Numeric + import Foreign.Ptr (Ptr, castPtr) + import Foreign.Storable (Storable (..)) + +-import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2# +- , subWordC#, timesWord#, timesWord2#, word2Int#, xor#) ++import GHC.Base (Int (..), int2Word#, minusWord#, not#, plusWord#, plusWord2# ++ , subWordC#, timesWord#, timesWord2#) + import GHC.Enum (predError, succError) +-import GHC.Exts ((+#), (*#), State#, Int#, Addr#, ByteArray#, MutableByteArray#) ++import GHC.Exts ((+#), (*#), State#, Int#, Addr#, ByteArray#, MutableByteArray#, Word#) ++#if __GLASGOW_HASKELL__ >= 903 ++import GHC.Exts (Word64#, and64#, or64#, word64ToInt64#, word64ToWord#, wordToWord64#, xor64#) ++#else ++import GHC.Exts (and#, or#, word2Int#, xor#) ++#endif + import GHC.Generics + import GHC.Int (Int64 (..)) + import GHC.Real ((%)) +@@ -200,7 +205,12 @@ compare128 :: Int128 -> Int128 -> Ordering + compare128 (Int128 a1 a0) (Int128 b1 b0) = + compare (int64OfWord64 a1) (int64OfWord64 b1) <> compare a0 b0 + where +- int64OfWord64 (W64# w) = I64# (word2Int# w) ++ int64OfWord64 (W64# w) = ++#if __GLASGOW_HASKELL__ >= 903 ++ I64# (word64ToInt64# w) ++#else ++ I64# (word2Int# w) ++#endif + + -- ----------------------------------------------------------------------------- + -- Functions for `Enum` instance. +@@ -236,36 +246,52 @@ fromEnum128 (Int128 _ a0) = fromEnum a0 + {-# INLINABLE plus128 #-} + plus128 :: Int128 -> Int128 -> Int128 + plus128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# s1) (W64# s0) ++ Int128 (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# c1, s0 #) = plusWord2# a0 b0 +- s1a = plusWord# a1 b1 ++ !(# c1, s0 #) = plusWord2# a0' b0' ++ s1a = plusWord# a1' b1' + s1 = plusWord# c1 s1a + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ + {-# INLINABLE minus128 #-} + minus128 :: Int128 -> Int128 -> Int128 + minus128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# d1) (W64# d0) ++ Int128 (W64# (wordToWord64Compat# d1)) (W64# (wordToWord64Compat# d0)) + where +- !(# d0, c1 #) = subWordC# a0 b0 +- a1c = minusWord# a1 (int2Word# c1) +- d1 = minusWord# a1c b1 ++ !(# d0, c1 #) = subWordC# a0' b0' ++ a1c = minusWord# a1' (int2Word# c1) ++ d1 = minusWord# a1c b1' ++ ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 + + times128 :: Int128 -> Int128 -> Int128 + times128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# p1) (W64# p0) ++ Int128 (W64# (wordToWord64Compat# p1)) (W64# (wordToWord64Compat# p0)) + where +- !(# c1, p0 #) = timesWord2# a0 b0 +- p1a = timesWord# a1 b0 +- p1b = timesWord# a0 b1 ++ !(# c1, p0 #) = timesWord2# a0' b0' ++ p1a = timesWord# a1' b0' ++ p1b = timesWord# a0' b1' + p1c = plusWord# p1a p1b + p1 = plusWord# p1c c1 + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ + {-# INLINABLE negate128 #-} + negate128 :: Int128 -> Int128 + negate128 (Int128 (W64# a1) (W64# a0)) = +- case plusWord2# (not# a0) 1## of +- (# c, s #) -> Int128 (W64# (plusWord# (not# a1) c)) (W64# s) ++ case plusWord2# (not# (word64ToWordCompat# a0)) 1## of ++ (# c, s #) -> Int128 (W64# (wordToWord64Compat# (plusWord# (not# (word64ToWordCompat# a1)) c))) ++ (W64# (wordToWord64Compat# s)) + + {-# INLINABLE abs128 #-} + abs128 :: Int128 -> Int128 +@@ -294,17 +320,41 @@ fromInteger128 i = + {-# INLINABLE and128 #-} + and128 :: Int128 -> Int128 -> Int128 + and128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# (and# a1 b1)) (W64# (and# a0 b0)) ++ Int128 (W64# (and64Compat# a1 b1)) (W64# (and64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ and64Compat# :: Word64# -> Word64# -> Word64# ++ and64Compat# = and64# ++#else ++ and64Compat# :: Word# -> Word# -> Word# ++ and64Compat# = and# ++#endif + + {-# INLINABLE or128 #-} + or128 :: Int128 -> Int128 -> Int128 + or128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# (or# a1 b1)) (W64# (or# a0 b0)) ++ Int128 (W64# (or64Compat# a1 b1)) (W64# (or64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ or64Compat# :: Word64# -> Word64# -> Word64# ++ or64Compat# = or64# ++#else ++ or64Compat# :: Word# -> Word# -> Word# ++ or64Compat# = or# ++#endif + + {-# INLINABLE xor128 #-} + xor128 :: Int128 -> Int128 -> Int128 + xor128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) = +- Int128 (W64# (xor# a1 b1)) (W64# (xor# a0 b0)) ++ Int128 (W64# (xor64Compat# a1 b1)) (W64# (xor64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ xor64Compat# :: Word64# -> Word64# -> Word64# ++ xor64Compat# = xor64# ++#else ++ xor64Compat# :: Word# -> Word# -> Word# ++ xor64Compat# = xor# ++#endif + + -- Probably not worth inlining this. + shiftL128 :: Int128 -> Int -> Int128 +@@ -558,3 +608,17 @@ index1 = 0 + index0 = 0 + index1 = 1 + #endif ++ ++#if __GLASGOW_HASKELL__ >= 903 ++word64ToWordCompat# :: Word64# -> Word# ++word64ToWordCompat# = word64ToWord# ++ ++wordToWord64Compat# :: Word# -> Word64# ++wordToWord64Compat# = wordToWord64# ++#else ++word64ToWordCompat# :: Word# -> Word# ++word64ToWordCompat# x = x ++ ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++#endif +diff --git a/src/Data/WideWord/Word128.hs b/src/Data/WideWord/Word128.hs +index 765f3a5..9dfad72 100644 +--- a/src/Data/WideWord/Word128.hs ++++ b/src/Data/WideWord/Word128.hs +@@ -43,10 +43,15 @@ import Data.Semigroup ((<>)) + import Foreign.Ptr (Ptr, castPtr) + import Foreign.Storable (Storable (..)) + +-import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2# +- , quotRemWord2#, subWordC#, timesWord#, timesWord2#, xor#) ++import GHC.Base (Int (..), int2Word#, minusWord#, not#, plusWord#, plusWord2# ++ , quotRemWord2#, subWordC#, timesWord#, timesWord2#) + import GHC.Enum (predError, succError) +-import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#) ++import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#, Word#) ++#if __GLASGOW_HASKELL__ >= 903 ++import GHC.Exts (Word64#, and64#, eqWord64#, or64#, tagToEnum#, word64ToWord#, wordToWord64#, xor64#) ++#else ++import GHC.Exts (and#, or#, xor#) ++#endif + import GHC.Generics + import GHC.Real ((%), divZeroError) + import GHC.Word (Word64 (..), Word32, byteSwap64) +@@ -233,40 +238,64 @@ fromEnum128 (Word128 _ a0) = fromEnum a0 + {-# INLINABLE plus128 #-} + plus128 :: Word128 -> Word128 -> Word128 + plus128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# s1) (W64# s0) ++ Word128 (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# c1, s0 #) = plusWord2# a0 b0 +- s1a = plusWord# a1 b1 ++ !(# c1, s0 #) = plusWord2# a0' b0' ++ s1a = plusWord# a1' b1' + s1 = plusWord# c1 s1a + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ + {-# INLINABLE minus128 #-} + minus128 :: Word128 -> Word128 -> Word128 + minus128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# d1) (W64# d0) ++ Word128 (W64# (wordToWord64Compat# d1)) (W64# (wordToWord64Compat# d0)) + where +- !(# d0, c1 #) = subWordC# a0 b0 +- a1c = minusWord# a1 (int2Word# c1) +- d1 = minusWord# a1c b1 ++ !(# d0, c1 #) = subWordC# a0' b0' ++ a1c = minusWord# a1' (int2Word# c1) ++ d1 = minusWord# a1c b1' ++ ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 + + times128 :: Word128 -> Word128 -> Word128 + times128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# p1) (W64# p0) ++ Word128 (W64# (wordToWord64Compat# p1)) (W64# (wordToWord64Compat# p0)) + where +- !(# c1, p0 #) = timesWord2# a0 b0 +- p1a = timesWord# a1 b0 +- p1b = timesWord# a0 b1 ++ !(# c1, p0 #) = timesWord2# a0' b0' ++ p1a = timesWord# a1' b0' ++ p1b = timesWord# a0' b1' + p1c = plusWord# p1a p1b + p1 = plusWord# p1c c1 + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ + {-# INLINABLE negate128 #-} + negate128 :: Word128 -> Word128 + negate128 (Word128 (W64# a1) (W64# a0)) = +- case plusWord2# (not# a0) 1## of +- (# c, s #) -> Word128 (W64# (plusWord# (not# a1) c)) (W64# s) ++ case plusWord2# (not# (word64ToWordCompat# a0)) 1## of ++ (# c, s #) -> Word128 (W64# (wordToWord64Compat# (plusWord# (not# (word64ToWordCompat# a1)) c))) ++ (W64# (wordToWord64Compat# s)) + + {-# INLINABLE signum128 #-} + signum128 :: Word128 -> Word128 +-signum128 (Word128 (W64# 0##) (W64# 0##)) = zeroWord128 ++signum128 ++#if __GLASGOW_HASKELL__ >= 903 ++ (Word128 (W64# a1) (W64# a0)) ++ | tagToEnum# (a1 `eqWord64#` wordToWord64Compat# 0##) ++ , tagToEnum# (a0 `eqWord64#` wordToWord64Compat# 0##) ++#else ++ (Word128 (W64# 0##) (W64# 0##)) ++#endif ++ = zeroWord128 + signum128 _ = oneWord128 + + fromInteger128 :: Integer -> Word128 +@@ -279,17 +308,41 @@ fromInteger128 i = + {-# INLINABLE and128 #-} + and128 :: Word128 -> Word128 -> Word128 + and128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# (and# a1 b1)) (W64# (and# a0 b0)) ++ Word128 (W64# (and64Compat# a1 b1)) (W64# (and64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ and64Compat# :: Word64# -> Word64# -> Word64# ++ and64Compat# = and64# ++#else ++ and64Compat# :: Word# -> Word# -> Word# ++ and64Compat# = and# ++#endif + + {-# INLINABLE or128 #-} + or128 :: Word128 -> Word128 -> Word128 + or128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# (or# a1 b1)) (W64# (or# a0 b0)) ++ Word128 (W64# (or64Compat# a1 b1)) (W64# (or64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ or64Compat# :: Word64# -> Word64# -> Word64# ++ or64Compat# = or64# ++#else ++ or64Compat# :: Word# -> Word# -> Word# ++ or64Compat# = or# ++#endif + + {-# INLINABLE xor128 #-} + xor128 :: Word128 -> Word128 -> Word128 + xor128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = +- Word128 (W64# (xor# a1 b1)) (W64# (xor# a0 b0)) ++ Word128 (W64# (xor64Compat# a1 b1)) (W64# (xor64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ xor64Compat# :: Word64# -> Word64# -> Word64# ++ xor64Compat# = xor64# ++#else ++ xor64Compat# :: Word# -> Word# -> Word# ++ xor64Compat# = xor# ++#endif + + {-# INLINABLE complement128 #-} + complement128 :: Word128 -> Word128 +@@ -412,12 +465,16 @@ quotRemFour num@(Word128 n1 _) den@(Word128 d1 _) + {-# INLINE halfTimes128 #-} + halfTimes128 :: Word128 -> Word64 -> Word128 + halfTimes128 (Word128 (W64# a1) (W64# a0)) (W64# b0) = +- Word128 (W64# p1) (W64# p0) ++ Word128 (W64# (wordToWord64Compat# p1)) (W64# (wordToWord64Compat# p0)) + where +- !(# c1, p0 #) = timesWord2# a0 b0 +- p1a = timesWord# a1 b0 ++ !(# c1, p0 #) = timesWord2# a0' b0' ++ p1a = timesWord# a1' b0' + p1 = plusWord# p1a c1 + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !b0' = word64ToWordCompat# b0 ++ + {-# INLINE quotRemThree #-} + quotRemThree :: Word128 -> Word64 -> (Word128, Word128) + quotRemThree num@(Word128 n1 n0) den +@@ -433,8 +490,8 @@ quotRemThree num@(Word128 n1 n0) den + {-# INLINE quotRemWord64 #-} + quotRemWord64 :: Word64 -> Word64 -> Word64 -> (Word64, Word64) + quotRemWord64 (W64# n1) (W64# n0) (W64# d) = +- case quotRemWord2# n1 n0 d of +- (# q, r #) -> (W64# q, W64# r) ++ case quotRemWord2# (word64ToWordCompat# n1) (word64ToWordCompat# n0) (word64ToWordCompat# d) of ++ (# q, r #) -> (W64# (wordToWord64Compat# q), W64# (wordToWord64Compat# r)) + + + {-# INLINE quotRemTwo #-} +@@ -561,3 +618,17 @@ index1 = 0 + index0 = 0 + index1 = 1 + #endif ++ ++#if __GLASGOW_HASKELL__ >= 903 ++word64ToWordCompat# :: Word64# -> Word# ++word64ToWordCompat# = word64ToWord# ++ ++wordToWord64Compat# :: Word# -> Word64# ++wordToWord64Compat# = wordToWord64# ++#else ++word64ToWordCompat# :: Word# -> Word# ++word64ToWordCompat# x = x ++ ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++#endif +diff --git a/src/Data/WideWord/Word256.hs b/src/Data/WideWord/Word256.hs +index 92fd8ab..2512000 100644 +--- a/src/Data/WideWord/Word256.hs ++++ b/src/Data/WideWord/Word256.hs +@@ -42,10 +42,15 @@ import Data.Semigroup ((<>)) + import Foreign.Ptr (Ptr, castPtr) + import Foreign.Storable (Storable (..)) + +-import GHC.Base (Int (..), and#, minusWord#, not#, or#, plusWord#, plusWord2# +- , subWordC#, timesWord#, timesWord2#, xor#) ++import GHC.Base (Int (..), minusWord#, not#, plusWord#, plusWord2# ++ , subWordC#, timesWord#, timesWord2#) + import GHC.Enum (predError, succError) +-import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#) ++import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#, Word#) ++#if __GLASGOW_HASKELL__ >= 903 ++import GHC.Exts (Word64#, and64#, eqWord64#, or64#, tagToEnum#, word64ToWord#, wordToWord64#, xor64#) ++#else ++import GHC.Exts (and#, or#, xor#) ++#endif + import GHC.Generics + import GHC.Real ((%)) + import GHC.Word (Word64 (..), Word32) +@@ -250,58 +255,79 @@ fromEnum256 (Word256 _ _ _ a0) = fromEnum a0 + plus256 :: Word256 -> Word256 -> Word256 + plus256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) ++ Word256 (W64# (wordToWord64Compat# s3)) (W64# (wordToWord64Compat# s2)) ++ (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# c1, s0 #) = plusWord2# a0 b0 +- !(# c2a, s1a #) = plusWord2# a1 b1 ++ !(# c1, s0 #) = plusWord2# a0' b0' ++ !(# c2a, s1a #) = plusWord2# a1' b1' + !(# c2b, s1 #) = plusWord2# s1a c1 + c2 = plusWord# c2a c2b +- !(# c3a, s2a #) = plusWord2# a2 b2 ++ !(# c3a, s2a #) = plusWord2# a2' b2' + !(# c3b, s2 #) = plusWord2# s2a c2 + c3 = plusWord# c3a c3b +- s3 = plusWord# a3 (plusWord# b3 c3) ++ s3 = plusWord# a3' (plusWord# b3' c3) ++ ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !a2' = word64ToWordCompat# a2 ++ !a3' = word64ToWordCompat# a3 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ !b2' = word64ToWordCompat# b2 ++ !b3' = word64ToWordCompat# b3 + + {-# INLINABLE minus256 #-} + minus256 :: Word256 -> Word256 -> Word256 + minus256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) ++ Word256 (W64# (wordToWord64Compat# s3)) (W64# (wordToWord64Compat# s2)) ++ (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + where +- !(# s0, v1 #) = subWordC# a0 b0 ++ !(# s0, v1 #) = subWordC# a0' b0' + !(# s1, v2 #) = + case v1 of +- 0# -> subWordC# a1 b1 ++ 0# -> subWordC# a1' b1' + _ -> +- case a1 of +- 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b1, 1# #) +- _ -> subWordC# (minusWord# a1 1##) b1 ++ case a1' of ++ 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b1', 1# #) ++ _ -> subWordC# (minusWord# a1' 1##) b1' + !(# s2, v3 #) = + case v2 of +- 0# -> subWordC# a2 b2 ++ 0# -> subWordC# a2' b2' + _ -> +- case a2 of +- 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b2, 1# #) +- _ -> subWordC# (minusWord# a2 1##) b2 ++ case a2' of ++ 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b2', 1# #) ++ _ -> subWordC# (minusWord# a2' 1##) b2' + !s3 = + case v3 of +- 0# -> minusWord# a3 b3 +- _ -> minusWord# (minusWord# a3 1##) b3 ++ 0# -> minusWord# a3' b3' ++ _ -> minusWord# (minusWord# a3' 1##) b3' ++ ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !a2' = word64ToWordCompat# a2 ++ !a3' = word64ToWordCompat# a3 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ !b2' = word64ToWordCompat# b2 ++ !b3' = word64ToWordCompat# b3 + + times256 :: Word256 -> Word256 -> Word256 + times256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# r3) (W64# r2) (W64# r1) (W64# r0) ++ Word256 (W64# (wordToWord64Compat# r3)) (W64# (wordToWord64Compat# r2)) ++ (W64# (wordToWord64Compat# r1)) (W64# (wordToWord64Compat# r0)) + where +- !(# c00, p00 #) = timesWord2# a0 b0 +- !(# c01, p01 #) = timesWord2# a0 b1 +- !(# c02, p02 #) = timesWord2# a0 b2 +- !p03 = timesWord# a0 b3 +- !(# c10, p10 #) = timesWord2# a1 b0 +- !(# c11, p11 #) = timesWord2# a1 b1 +- !p12 = timesWord# a1 b2 +- !(# c20, p20 #) = timesWord2# a2 b0 +- !p21 = timesWord# a2 b1 +- !p30 = timesWord# a3 b0 ++ !(# c00, p00 #) = timesWord2# a0' b0' ++ !(# c01, p01 #) = timesWord2# a0' b1' ++ !(# c02, p02 #) = timesWord2# a0' b2' ++ !p03 = timesWord# a0' b3' ++ !(# c10, p10 #) = timesWord2# a1' b0' ++ !(# c11, p11 #) = timesWord2# a1' b1' ++ !p12 = timesWord# a1' b2' ++ !(# c20, p20 #) = timesWord2# a2' b0' ++ !p21 = timesWord# a2' b1' ++ !p30 = timesWord# a3' b0' + !r0 = p00 + !c1 = c00 + !(# c2x, r1a #) = plusWord2# p01 p10 +@@ -320,18 +346,38 @@ times256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + c3t `plusWord#` c02 `plusWord#` c11 `plusWord#` + c20 + ++ !a0' = word64ToWordCompat# a0 ++ !a1' = word64ToWordCompat# a1 ++ !a2' = word64ToWordCompat# a2 ++ !a3' = word64ToWordCompat# a3 ++ !b0' = word64ToWordCompat# b0 ++ !b1' = word64ToWordCompat# b1 ++ !b2' = word64ToWordCompat# b2 ++ !b3' = word64ToWordCompat# b3 ++ + {-# INLINABLE negate256 #-} + negate256 :: Word256 -> Word256 + negate256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) = +- case plusWord2# (not# a0) 1## of +- (# c1, s0 #) -> case plusWord2# (not# a1) c1 of +- (# c2, s1 #) -> case plusWord2# (not# a2) c2 of +- (# c3, s2 #) -> case plusWord# (not# a3) c3 of +- s3 -> Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) ++ case plusWord2# (not# (word64ToWordCompat# a0)) 1## of ++ (# c1, s0 #) -> case plusWord2# (not# (word64ToWordCompat# a1)) c1 of ++ (# c2, s1 #) -> case plusWord2# (not# (word64ToWordCompat# a2)) c2 of ++ (# c3, s2 #) -> case plusWord# (not# (word64ToWordCompat# a3)) c3 of ++ s3 -> Word256 (W64# (wordToWord64Compat# s3)) (W64# (wordToWord64Compat# s2)) ++ (W64# (wordToWord64Compat# s1)) (W64# (wordToWord64Compat# s0)) + + {-# INLINABLE signum256 #-} + signum256 :: Word256 -> Word256 +-signum256 (Word256 (W64# 0##) (W64# 0##) (W64# 0##) (W64# 0##)) = zeroWord256 ++signum256 ++#if __GLASGOW_HASKELL__ >= 903 ++ (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) ++ | tagToEnum# (a3 `eqWord64#` wordToWord64Compat# 0##) ++ , tagToEnum# (a2 `eqWord64#` wordToWord64Compat# 0##) ++ , tagToEnum# (a1 `eqWord64#` wordToWord64Compat# 0##) ++ , tagToEnum# (a0 `eqWord64#` wordToWord64Compat# 0##) ++#else ++ (Word256 (W64# 0##) (W64# 0##) (W64# 0##) (W64# 0##)) ++#endif ++ = zeroWord256 + signum256 _ = oneWord256 + + fromInteger256 :: Integer -> Word256 +@@ -348,22 +394,46 @@ fromInteger256 i = Word256 + and256 :: Word256 -> Word256 -> Word256 + and256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# (and# a3 b3)) (W64# (and# a2 b2)) +- (W64# (and# a1 b1)) (W64# (and# a0 b0)) ++ Word256 (W64# (and64Compat# a3 b3)) (W64# (and64Compat# a2 b2)) ++ (W64# (and64Compat# a1 b1)) (W64# (and64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ and64Compat# :: Word64# -> Word64# -> Word64# ++ and64Compat# = and64# ++#else ++ and64Compat# :: Word# -> Word# -> Word# ++ and64Compat# = and# ++#endif + + {-# INLINABLE or256 #-} + or256 :: Word256 -> Word256 -> Word256 + or256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# (or# a3 b3)) (W64# (or# a2 b2)) +- (W64# (or# a1 b1)) (W64# (or# a0 b0)) ++ Word256 (W64# (or64Compat# a3 b3)) (W64# (or64Compat# a2 b2)) ++ (W64# (or64Compat# a1 b1)) (W64# (or64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ or64Compat# :: Word64# -> Word64# -> Word64# ++ or64Compat# = or64# ++#else ++ or64Compat# :: Word# -> Word# -> Word# ++ or64Compat# = or# ++#endif + + {-# INLINABLE xor256 #-} + xor256 :: Word256 -> Word256 -> Word256 + xor256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) + (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +- Word256 (W64# (xor# a3 b3)) (W64# (xor# a2 b2)) +- (W64# (xor# a1 b1)) (W64# (xor# a0 b0)) ++ Word256 (W64# (xor64Compat# a3 b3)) (W64# (xor64Compat# a2 b2)) ++ (W64# (xor64Compat# a1 b1)) (W64# (xor64Compat# a0 b0)) ++ where ++#if __GLASGOW_HASKELL__ >= 903 ++ xor64Compat# :: Word64# -> Word64# -> Word64# ++ xor64Compat# = xor64# ++#else ++ xor64Compat# :: Word# -> Word# -> Word# ++ xor64Compat# = xor# ++#endif + + {-# INLINABLE complement256 #-} + complement256 :: Word256 -> Word256 +@@ -641,3 +711,17 @@ index1 = 1 + index2 = 2 + index3 = 3 + #endif ++ ++#if __GLASGOW_HASKELL__ >= 903 ++word64ToWordCompat# :: Word64# -> Word# ++word64ToWordCompat# = word64ToWord# ++ ++wordToWord64Compat# :: Word# -> Word64# ++wordToWord64Compat# = wordToWord64# ++#else ++word64ToWordCompat# :: Word# -> Word# ++word64ToWordCompat# x = x ++ ++wordToWord64Compat# :: Word# -> Word# ++wordToWord64Compat# x = x ++#endif