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