diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
 # Revision history for wide-word
 
+## 0.1.0.9 -- 2019-02-06
+
+* Fix `Prim` instance for `Int128`
+
 ## 0.1.0.8  -- 2019-01-31
 
 * Improve implementation of succ/pred.
diff --git a/src/Data/WideWord/Int128.hs b/src/Data/WideWord/Int128.hs
--- a/src/Data/WideWord/Int128.hs
+++ b/src/Data/WideWord/Int128.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE StrictData #-}
@@ -33,6 +34,8 @@
 import Control.DeepSeq (NFData (..))
 
 import Data.Bits (Bits (..), FiniteBits (..), shiftL)
+import Data.Data (Data, Typeable)
+import Data.Ix (Ix)
 
 import Data.WideWord.Word128
 
@@ -55,7 +58,7 @@
   { int128Hi64 :: {-# UNPACK #-} !Word64
   , int128Lo64 :: {-# UNPACK #-} !Word64
   }
-  deriving (Eq)
+  deriving (Eq, Data, Ix, Typeable)
 
 byteSwapInt128 :: Int128 -> Int128
 byteSwapInt128 (Int128 a1 a0) = Int128 (byteSwap64 a0) (byteSwap64 a1)
@@ -386,28 +389,28 @@
 
 quotRem128 :: Int128 -> Int128 -> (Int128, Int128)
 quotRem128 numer denom
-  | numerIsNegative && denomIsNegative = (word128ToInt128 wq, word128ToInt128 (negate wr))
-  | numerIsNegative = (word128ToInt128 (negate wq), word128ToInt128 (negate wr))
-  | denomIsNegative = (word128ToInt128 (negate wq), word128ToInt128 wr)
+  | isNeg numer && isNeg denom = (word128ToInt128 wq, word128ToInt128 (negate wr))
+  | isNeg numer = (word128ToInt128 (negate wq), word128ToInt128 (negate wr))
+  | isNeg denom = (word128ToInt128 (negate wq), word128ToInt128 wr)
   | otherwise = (word128ToInt128 wq, word128ToInt128 wr)
   where
     (wq, wr) = quotRem absNumerW absDenomW
     absNumerW = int128ToWord128 $ abs128 numer
     absDenomW = int128ToWord128 $ abs128 denom
-    numerIsNegative = topBitSetWord64 $ int128Hi64 numer
-    denomIsNegative = topBitSetWord64 $ int128Hi64 denom
+    isNeg = topBitSetWord64 . int128Hi64
 
 
 divMod128 :: Int128 -> Int128 -> (Int128, Int128)
 divMod128 numer denom
-  | numerIsNegative && denomIsNegative = (word128ToInt128 wq, word128ToInt128 (negate wr))
-  | numerIsNegative = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (absDenomW - wr))
-  | denomIsNegative = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (negate $ absDenomW - wr))
+  | isNeg numer && isNeg denom = (word128ToInt128 wq, word128ToInt128 (negate wr))
+  | isNeg numer && wr == 0 = (word128ToInt128 (negate wq), 0)
+  | isNeg numer = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (absDenomW - wr))
+  | isNeg denom && wr == 0 = (word128ToInt128 (negate wq), 0)
+  | isNeg denom = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (negate $ absDenomW - wr))
   | otherwise = (word128ToInt128 wq, word128ToInt128 wr)
   where
     (wq, wr) = quotRem absNumerW absDenomW
-    numerIsNegative = topBitSetWord64 $ int128Hi64 numer
-    denomIsNegative = topBitSetWord64 $ int128Hi64 denom
+    isNeg = topBitSetWord64 . int128Hi64
     absNumerW = int128ToWord128 $ abs128 numer
     absDenomW = int128ToWord128 $ abs128 denom
 
@@ -429,8 +432,9 @@
 
 peekElemOff128 :: Ptr Int128 -> Int -> IO Int128
 peekElemOff128 ptr idx =
-  Int128 <$> peekElemOff (castPtr ptr) (2 * idx + index1)
-            <*> peekElemOff (castPtr ptr) (2 * idx + index0)
+  Int128 <$> peekElemOff (castPtr ptr) (idx2 + index1)
+            <*> peekElemOff (castPtr ptr) (idx2 + index0)
+  where idx2 = 2 * idx
 
 poke128 :: Ptr Int128 -> Int128 -> IO ()
 poke128 ptr (Int128 a1 a0) =
@@ -438,8 +442,9 @@
 
 pokeElemOff128 :: Ptr Int128 -> Int -> Int128 -> IO ()
 pokeElemOff128 ptr idx (Int128 a1 a0) = do
-  pokeElemOff (castPtr ptr) (2 * idx + index0) a0
-  pokeElemOff (castPtr ptr) (2 * idx + index1) a1
+  let idx2 = 2 * idx
+  pokeElemOff (castPtr ptr) (idx2 + index0) a0
+  pokeElemOff (castPtr ptr) (idx2 + index1) a1
 
 -- -----------------------------------------------------------------------------
 -- Helpers.
@@ -470,23 +475,26 @@
 {-# INLINE indexByteArray128# #-}
 indexByteArray128# :: ByteArray# -> Int# -> Int128
 indexByteArray128# arr# i# =
-  let x = indexByteArray# arr# (2# *# (unInt index1))
-      y = indexByteArray# arr# (2# *# i# +# (unInt index0))
+  let i2# = 2# *# i#
+      x = indexByteArray# arr# (i2# +# unInt index1)
+      y = indexByteArray# arr# (i2# +# unInt index0)
   in Int128 x y
 
 {-# INLINE readByteArray128# #-}
 readByteArray128# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int128 #)
 readByteArray128# arr# i# =
-  \s0 -> case readByteArray# arr# (2# *# (unInt index1)) s0 of
-    (# s1, x #) -> case readByteArray# arr# (2# *# i# +# (unInt index0)) s1 of
+  \s0 -> case readByteArray# arr# (i2# +# unInt index1) s0 of
+    (# s1, x #) -> case readByteArray# arr# (i2# +# unInt index0) s1 of
       (# s2, y #) -> (# s2, Int128 x y #)
+  where i2# = 2# *# i#
 
 {-# INLINE writeByteArray128# #-}
 writeByteArray128# :: MutableByteArray# s -> Int# -> Int128 -> State# s -> State# s
 writeByteArray128# arr# i# (Int128 a b) =
-  \s0 -> case writeByteArray# arr# (2# *# i# +# (unInt index1)) a s0 of
-    s1 -> case writeByteArray# arr# (2# *# i# +# (unInt index0)) b s1 of
+  \s0 -> case writeByteArray# arr# (i2# +# unInt index1) a s0 of
+    s1 -> case writeByteArray# arr# (i2# +# unInt index0) b s1 of
       s2 -> s2
+  where i2# = 2# *# i#
 
 {-# INLINE setByteArray128# #-}
 setByteArray128# :: MutableByteArray# s -> Int# -> Int# -> Int128 -> State# s -> State# s
@@ -495,23 +503,26 @@
 {-# INLINE indexOffAddr128# #-}
 indexOffAddr128# :: Addr# -> Int# -> Int128
 indexOffAddr128# addr# i# =
-  let x = indexOffAddr# addr# (2# *# i# +# (unInt index1))
-      y = indexOffAddr# addr# (2# *# i# +# (unInt index0))
+  let i2# = 2# *# i#
+      x = indexOffAddr# addr# (i2# +# unInt index1)
+      y = indexOffAddr# addr# (i2# +# unInt index0)
   in Int128 x y
 
 {-# INLINE readOffAddr128# #-}
 readOffAddr128# :: Addr# -> Int# -> State# s -> (# State# s, Int128 #)
 readOffAddr128# addr# i# =
-  \s0 -> case readOffAddr# addr# (2# *# i# +# (unInt index1)) s0 of
-    (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# (unInt index0)) s1 of
+  \s0 -> case readOffAddr# addr# (i2# +# unInt index1) s0 of
+    (# s1, x #) -> case readOffAddr# addr# (i2# +# unInt index0) s1 of
       (# s2, y #) -> (# s2, Int128 x y #)
+  where i2# = 2# *# i#
 
 {-# INLINE writeOffAddr128# #-}
 writeOffAddr128# :: Addr# -> Int# -> Int128 -> State# s -> State# s
 writeOffAddr128# addr# i# (Int128 a b) =
-  \s0 -> case writeOffAddr# addr# (2# *# i# +# (unInt index1)) a s0 of
-    s1 -> case writeOffAddr# addr# (2# *# i# +# (unInt index0)) b s1 of
+  \s0 -> case writeOffAddr# addr# (i2# +# unInt index1) a s0 of
+    s1 -> case writeOffAddr# addr# (i2# +# unInt index0) b s1 of
       s2 -> s2
+  where i2# = 2# *# i#
 
 {-# INLINE setOffAddr128# #-}
 setOffAddr128# :: Addr# -> Int# -> Int# -> Int128 -> State# s -> State# s
diff --git a/src/Data/WideWord/Word128.hs b/src/Data/WideWord/Word128.hs
--- a/src/Data/WideWord/Word128.hs
+++ b/src/Data/WideWord/Word128.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE UnboxedTuples #-}
@@ -32,6 +33,8 @@
 import Control.DeepSeq (NFData (..))
 
 import Data.Bits (Bits (..), FiniteBits (..), shiftL)
+import Data.Data (Data, Typeable)
+import Data.Ix (Ix)
 
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable (..))
@@ -52,7 +55,7 @@
   { word128Hi64 :: {-# UNPACK #-} !Word64
   , word128Lo64 :: {-# UNPACK #-} !Word64
   }
-  deriving (Eq)
+  deriving (Eq, Data, Ix, Typeable)
 
 byteSwapWord128 :: Word128 -> Word128
 byteSwapWord128 (Word128 a1 a0) = Word128 (byteSwap64 a0) (byteSwap64 a1)
@@ -379,48 +382,51 @@
   | n1 == 0 && d1 == 0 = quotRemTwo n0 d0
   | n1 < d1 = (zeroWord128, num)
   | d1 == 0 = quotRemThree num d0
+  | n1 == d1 =
+      case compare n0 d0 of
+        LT -> (zeroWord128, num)
+        EQ -> (oneWord128, zeroWord128)
+        GT -> (Word128 0 1, Word128 0 (n0 - d0))
   | otherwise = quotRemFour num den
 
-
+{-# INLINE quotRemFour #-}
 quotRemFour :: Word128 -> Word128 -> (Word128, Word128)
-quotRemFour num@(Word128 n1 _) den@(Word128 d1 d0)
-  | n1 == d1 = quotRemFourX num d0
-  | otherwise = (q, r)
-      where
-        qtest = quot n1 d1
-        diff = times128 den (Word128 0 qtest)
-        (q, r) = case compare128 num diff of
-                    EQ -> (Word128 0 qtest, zeroWord128)
-                    GT -> (Word128 0 qtest, minus128 num diff)
-                    LT -> let qx = Word128 0 (qtest - 1)
-                              diffx = times128 den qx
-                          in (qx, minus128 num diffx)
-
-
-{-# INLINE quotRemFourX #-}
-quotRemFourX :: Word128 -> Word64 -> (Word128, Word128)
-quotRemFourX num@(Word128 _ n0) d0 =
-  case compare n0 d0 of
-    LT -> (zeroWord128, num)
-    EQ -> (oneWord128, zeroWord128)
-    GT -> (Word128 0 1, Word128 0 (n0 - d0))
+quotRemFour num@(Word128 n1 _) den@(Word128 d1 _)
+  | remain < den = (Word128 0 qest, remain)
+    -- The above is correct in most cases, but for the case where is not
+    -- we have the following. While the following is correct, it is rather
+    -- suboptimal. Would be nice to find something better.
+  | otherwise =
+      mapPair fromInteger128 $ quotRem (toInteger num) (toInteger den)
+  where
+    qest = quot n1 d1
+    prod = halfTimes128 den qest
+    remain = minus128 num prod
 
+{-# INLINE halfTimes128 #-}
+halfTimes128 :: Word128 -> Word64 -> Word128
+halfTimes128 (Word128 (W64# a1) (W64# a0)) (W64# b0) =
+  Word128 (W64# p1) (W64# p0)
+  where
+    !(# c1, p0 #) = timesWord2# a0 b0
+    p1a = timesWord# a1 b0
+    p1 = plusWord# p1a c1
 
 {-# INLINE quotRemThree #-}
 quotRemThree :: Word128 -> Word64 -> (Word128, Word128)
 quotRemThree num@(Word128 n1 n0) den
   | den == 0 = divZeroError
   | den == 1 = (num, zeroWord128)
-  | n1 < den = case quotRemWord2 n1 n0 den of
+  | n1 < den = case quotRemWord64 n1 n0 den of
                 (q, r) -> (Word128 0 q, Word128 0 r)
   | otherwise =
       case quotRem n1 den of
-        (q1, r1) -> case quotRemWord2 r1 n0 den of
+        (q1, r1) -> case quotRemWord64 r1 n0 den of
                       (q0, r0) -> (Word128 q1 q0, Word128 0 r0)
 
-{-# INLINE quotRemWord2 #-}
-quotRemWord2 :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
-quotRemWord2 (W64# n1) (W64# n0) (W64# d) =
+{-# 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)
 
@@ -431,6 +437,7 @@
   case quotRem n0 d0 of
     (q, r) -> (Word128 0 q, Word128 0 r)
 
+{-# INLINE toInteger128 #-}
 toInteger128 :: Word128 -> Integer
 toInteger128 (Word128 a1 a0) = fromIntegral a1 `shiftL` 64 + fromIntegral a0
 
@@ -443,8 +450,9 @@
 
 peekElemOff128 :: Ptr Word128 -> Int -> IO Word128
 peekElemOff128 ptr idx =
-  Word128 <$> peekElemOff (castPtr ptr) (2 * idx + index1)
-            <*> peekElemOff (castPtr ptr) (2 * idx + index0)
+  Word128 <$> peekElemOff (castPtr ptr) (idx2 + index1)
+            <*> peekElemOff (castPtr ptr) (idx2 + index0)
+  where idx2 = 2 * idx
 
 poke128 :: Ptr Word128 -> Word128 -> IO ()
 poke128 ptr (Word128 a1 a0) =
@@ -452,8 +460,9 @@
 
 pokeElemOff128 :: Ptr Word128 -> Int -> Word128 -> IO ()
 pokeElemOff128 ptr idx (Word128 a1 a0) = do
-  pokeElemOff (castPtr ptr) (2 * idx + index0) a0
-  pokeElemOff (castPtr ptr) (2 * idx + index1) a1
+  let idx2 = 2 * idx
+  pokeElemOff (castPtr ptr) (idx2 + index0) a0
+  pokeElemOff (castPtr ptr) (idx2 + index1) a1
 
 -- -----------------------------------------------------------------------------
 -- Functions for `Prim` instance.
@@ -469,23 +478,26 @@
 {-# INLINE indexByteArray128# #-}
 indexByteArray128# :: ByteArray# -> Int# -> Word128
 indexByteArray128# arr# i# =
-  let x = indexByteArray# arr# (2# *# i# +# (unInt index1))
-      y = indexByteArray# arr# (2# *# i# +# (unInt index0))
+  let i2# = 2# *# i#
+      x = indexByteArray# arr# (i2# +# unInt index1)
+      y = indexByteArray# arr# (i2# +# unInt index0)
   in Word128 x y
 
 {-# INLINE readByteArray128# #-}
 readByteArray128# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word128 #)
 readByteArray128# arr# i# =
-  \s0 -> case readByteArray# arr# (2# *# i# +# (unInt index1)) s0 of
-    (# s1, x #) -> case readByteArray# arr# (2# *# i# +# (unInt index0)) s1 of
+  \s0 -> case readByteArray# arr# (i2# +# unInt index1) s0 of
+    (# s1, x #) -> case readByteArray# arr# (i2# +# unInt index0) s1 of
       (# s2, y #) -> (# s2, Word128 x y #)
+  where i2# = 2# *# i#
 
 {-# INLINE writeByteArray128# #-}
 writeByteArray128# :: MutableByteArray# s -> Int# -> Word128 -> State# s -> State# s
 writeByteArray128# arr# i# (Word128 a b) =
-  \s0 -> case writeByteArray# arr# (2# *# i# +# (unInt index1)) a s0 of
-    s1 -> case writeByteArray# arr# (2# *# i# +# (unInt index0)) b s1 of
+  \s0 -> case writeByteArray# arr# (i2# +# unInt index1) a s0 of
+    s1 -> case writeByteArray# arr# (i2# +# unInt index0) b s1 of
       s2 -> s2
+  where i2# = 2# *# i#
 
 {-# INLINE setByteArray128# #-}
 setByteArray128# :: MutableByteArray# s -> Int# -> Int# -> Word128 -> State# s -> State# s
@@ -494,27 +506,33 @@
 {-# INLINE indexOffAddr128# #-}
 indexOffAddr128# :: Addr# -> Int# -> Word128
 indexOffAddr128# addr# i# =
-  let x = indexOffAddr# addr# (2# *# i# +# (unInt index1))
-      y = indexOffAddr# addr# (2# *# i# +# (unInt index0))
+  let i2# = 2# *# i#
+      x = indexOffAddr# addr# (i2# +# unInt index1)
+      y = indexOffAddr# addr# (i2# +# unInt index0)
   in Word128 x y
 
 {-# INLINE readOffAddr128# #-}
 readOffAddr128# :: Addr# -> Int# -> State# s -> (# State# s, Word128 #)
 readOffAddr128# addr# i# =
-  \s0 -> case readOffAddr# addr# (2# *# i# +# (unInt index1)) s0 of
-    (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# (unInt index0)) s1 of
+  \s0 -> case readOffAddr# addr# (i2# +# unInt index1) s0 of
+    (# s1, x #) -> case readOffAddr# addr# (i2# +# unInt index0) s1 of
       (# s2, y #) -> (# s2, Word128 x y #)
+  where i2# = 2# *# i#
 
 {-# INLINE writeOffAddr128# #-}
 writeOffAddr128# :: Addr# -> Int# -> Word128 -> State# s -> State# s
 writeOffAddr128# addr# i# (Word128 a b) =
-  \s0 -> case writeOffAddr# addr# (2# *# i# +# (unInt index1)) a s0 of
-    s1 -> case writeOffAddr# addr# (2# *# i# +# (unInt index0)) b s1 of
+  \s0 -> case writeOffAddr# addr# (i2# +# unInt index1) a s0 of
+    s1 -> case writeOffAddr# addr# (i2# +# unInt index0) b s1 of
       s2 -> s2
+  where i2# = 2# *# i#
 
 {-# INLINE setOffAddr128# #-}
 setOffAddr128# :: Addr# -> Int# -> Int# -> Word128 -> State# s -> State# s
 setOffAddr128# = defaultSetOffAddr#
+
+mapPair :: (a -> b) -> (a, a) -> (b, b)
+mapPair f (a, b) = (f a, f b)
 
 -- -----------------------------------------------------------------------------
 -- Constants.
diff --git a/test/Test/Data/WideWord/Gen.hs b/test/Test/Data/WideWord/Gen.hs
--- a/test/Test/Data/WideWord/Gen.hs
+++ b/test/Test/Data/WideWord/Gen.hs
@@ -1,41 +1,17 @@
 module Test.Data.WideWord.Gen where
 
-import           Data.Int (Int8, Int16, Int32, Int64)
+import           Data.Bits (shiftL)
 import           Data.WideWord
-import           Data.Word (Word8, Word16, Word32, Word64)
+import           Data.Word (Word32, Word64)
 
 import           Hedgehog (Gen)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
 
-genInt8 :: Gen Int8
-genInt8 =
-  Gen.int8 Range.constantBounded
-
-genInt16 :: Gen Int16
-genInt16 =
-  Gen.int16 Range.constantBounded
-
-genInt32 :: Gen Int32
-genInt32 =
-  Gen.int32 Range.constantBounded
-
-genInt64 :: Gen Int64
-genInt64 =
-  Gen.int64 Range.constantBounded
-
 genInt128 :: Gen Int128
 genInt128 =
-  Int128 <$> genWord64 <*> genWord64
-
-genWord8 :: Gen Word8
-genWord8 =
-  Gen.word8 Range.constantBounded
-
-genWord16 :: Gen Word16
-genWord16 =
-  Gen.word16 Range.constantBounded
+  Int128 <$> genBiasedWord64 <*> genBiasedWord64
 
 genWord32 :: Gen Word32
 genWord32 =
@@ -45,6 +21,28 @@
 genWord64 =
   Gen.word64 Range.constantBounded
 
+-- | Generate 'Word64' in one of five categories;
+--    * the full range
+--    * small values near zero
+--    * large values near maxBound :: Word64
+--    * values near maxBound / 2 :: Word64
+--    * values near maxBound :: Word32
+genBiasedWord64 :: Gen Word64
+genBiasedWord64 =
+  Gen.choice
+    [ Gen.word64 (Range.linear 0 maxBound)
+    , Gen.word64 (Range.linear 0 100)
+    , (-) maxBound <$> Gen.word64 (Range.linear 0 100)
+    , Gen.word64 (Range.linear (halfMax - 100) (halfMax + 100))
+    , Gen.word64 (Range.linear (bits32 - 100) (bits32 + 100))
+    ]
+  where
+    bits32 :: Word64
+    bits32 = 1 `shiftL` 32
+
+    halfMax :: Word64
+    halfMax = maxBound `div` 2
+
 genWord128 :: Gen Word128
 genWord128 =
-  Word128 <$> genWord64 <*> genWord64
+  Word128 <$> genBiasedWord64 <*> genBiasedWord64
diff --git a/test/Test/Data/WideWord/Int128.hs b/test/Test/Data/WideWord/Int128.hs
--- a/test/Test/Data/WideWord/Int128.hs
+++ b/test/Test/Data/WideWord/Int128.hs
@@ -3,13 +3,16 @@
   ( tests
   ) where
 
-import           Control.Exception (ArithException, evaluate, try)
+import           Control.Exception (SomeException, evaluate, try)
+import           Control.Monad (unless)
 import           Control.Monad.IO.Class (liftIO)
 
-import           Data.Bifunctor (bimap)
+import           Data.Bifunctor (first)
 import           Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros
                             , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor)
-import           Data.Word (Word64, byteSwap64)
+import           Data.Primitive.PrimArray
+import           Data.Primitive.Ptr
+import           Data.Word (Word8, Word64, byteSwap64)
 import           Data.WideWord
 
 import           Foreign (allocaBytes)
@@ -31,15 +34,15 @@
 prop_constructor_and_accessors :: Property
 prop_constructor_and_accessors =
   propertyCount $ do
-    (h, l) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (h, l) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     let i128 = Int128 h l
     (int128Hi64 i128, int128Lo64 i128) === (h, l)
 
 prop_byte_swap :: Property
 prop_byte_swap =
   propertyCount $ do
-    h <- H.forAll genWord64
-    l <- H.forAll $ Gen.filter (/= h) genWord64
+    h <- H.forAll genBiasedWord64
+    l <- H.forAll $ Gen.filter (/= h) genBiasedWord64
     let w128 = Int128 h l
         swapped = byteSwapInt128 w128
     (byteSwapInt128 swapped, byteSwap64 (fromIntegral h), byteSwap64 (fromIntegral l))
@@ -48,8 +51,8 @@
 prop_derivied_eq_instance :: Property
 prop_derivied_eq_instance =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
-    (b1, b0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
+    (b1, b0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     (Int128 a1 a0 == Int128 b1 b0) === (a1 == b1 && a0 == b0)
 
 prop_ord_instance :: Property
@@ -67,29 +70,34 @@
 prop_read_instance :: Property
 prop_read_instance =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     read (show $ Int128 a1 a0) === Int128 a1 a0
 
 prop_succ :: Property
 prop_succ =
   propertyCount $ do
     i128 <- H.forAll genInt128
-    res <- liftIO . try $ evaluate (succ i128)
-    bimap showArithException toInteger128 res
-        === if i128 == maxBound
+    res <- liftIO (fmap toInteger128 <$> tryEvaluate (succ i128))
+    res === if i128 == maxBound
               then Left "Enum.succ{Int128}: tried to take `succ' of maxBound"
-              else Right $ succ (toInteger128 i128)
+              else Right (succ $ toInteger128 i128)
 
 prop_pred :: Property
 prop_pred =
   propertyCount $ do
     i128 <- H.forAll genInt128
-    res <- liftIO . try $ evaluate (pred i128)
-    bimap showArithException toInteger128 res
-        === if i128 == 0
+    res <- liftIO (fmap toInteger128 <$> tryEvaluate (pred i128))
+    res === if i128 == minBound
               then Left "Enum.pred{Int128}: tried to take `pred' of minBound"
               else Right $ pred (toInteger128 i128)
 
+tryEvaluate :: a -> IO (Either String a)
+tryEvaluate x = do
+  first renderException <$> try (evaluate x)
+  where
+    renderException :: SomeException -> String
+    renderException = show
+
 prop_toEnum_fromEnum :: Property
 prop_toEnum_fromEnum =
   propertyCount $ do
@@ -141,7 +149,7 @@
 prop_fromInteger :: Property
 prop_fromInteger =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     let i128 = fromInteger $ mkInteger a1 a0
     (int128Hi64 i128, int128Lo64 i128) === (a1, a0)
 
@@ -187,14 +195,14 @@
 prop_logical_rotate_left :: Property
 prop_logical_rotate_left =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-20000) 20000)
     toInteger (rotateL (Int128 a1 a0) rot) === correctInt128 (toInteger $ rotateL (Word128 a1 a0) rot)
 
 prop_logical_rotate_right :: Property
 prop_logical_rotate_right =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-20000) 20000)
     toInteger (rotateR (Int128 a1 a0) rot) === correctInt128 (toInteger $ rotateR (Word128 a1 a0) rot)
 
@@ -224,13 +232,13 @@
 prop_popCount :: Property
 prop_popCount =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     popCount (Int128 a1 a0) === popCount a1 + popCount a0
 
 prop_countLeadingZeros :: Property
 prop_countLeadingZeros =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     let expected = if a1 == 0
                     then 64 + countLeadingZeros a0
                     else countLeadingZeros a1
@@ -239,7 +247,7 @@
 prop_countTrailingZeros :: Property
 prop_countTrailingZeros =
   propertyCount $ do
-    (a1, a0) <- H.forAll $ (,) <$> genWord64 <*> genWord64
+    (a1, a0) <- H.forAll $ (,) <$> genBiasedWord64 <*> genBiasedWord64
     let expected = if a0 == 0
                     then 64 + countTrailingZeros a1
                     else countTrailingZeros a0
@@ -285,7 +293,46 @@
                     (,) <$> peekElemOff ptr 0 <*>  peekElemOff ptr 1
     (toInteger128 ar, toInteger128 br) === (toInteger128 a128, toInteger128 b128)
 
+prop_ToFromPrimArray :: Property
+prop_ToFromPrimArray =
+  propertyCount $ do
+    as <- H.forAll $
+      Gen.list (fromIntegral <$> (Range.linearBounded :: Range.Range Word8)) genInt128
+    as === primArrayToList (primArrayFromList as)
 
+prop_WriteReadPrimArray :: Property
+prop_WriteReadPrimArray =
+  propertyCount $ do
+    as <- H.forAll $ Gen.list (Range.linear 1 256) genInt128
+    unless (null as) $ do
+      let len = length as
+          arr = primArrayFromList as
+      i <- (`mod` len) <$> H.forAll (Gen.int (Range.linear 0 (len - 1)))
+      new <- H.forAll genInt128
+      props <- liftIO $ do
+        marr <- unsafeThawPrimArray arr
+        prev <- readPrimArray marr i
+        let prevProp = prev === (as !! i)
+        writePrimArray marr i new
+        cur <- readPrimArray marr i
+        setPrimArray marr i 1 prev
+        arr' <- unsafeFreezePrimArray marr
+        return [prevProp, cur === new, arr === arr']
+      sequence_ props
+
+
+prop_readOffPtr_writeOffPtr :: Property
+prop_readOffPtr_writeOffPtr =
+  propertyCount $ do
+    a128 <- H.forAll genInt128
+    b128 <- H.forAll genInt128
+    (ar, br) <- liftIO $
+                  allocaBytes (2 * sizeOf zeroInt128) $ \ ptr -> do
+                    writeOffPtr ptr 0 a128
+                    writeOffPtr ptr 1 b128
+                    (,) <$> readOffPtr ptr 0 <*> readOffPtr ptr 1
+    (ar, br) === (a128, b128)
+
 -- -----------------------------------------------------------------------------
 
 mkInteger :: Word64 -> Word64 -> Integer
@@ -303,9 +350,6 @@
 
 toInteger128 :: Int128 -> Integer
 toInteger128 = toInteger
-
-showArithException :: ArithException -> String
-showArithException = show
 
 -- -----------------------------------------------------------------------------
 
diff --git a/test/Test/Data/WideWord/Word128.hs b/test/Test/Data/WideWord/Word128.hs
--- a/test/Test/Data/WideWord/Word128.hs
+++ b/test/Test/Data/WideWord/Word128.hs
@@ -3,13 +3,16 @@
   ( tests
   ) where
 
-import           Control.Exception (ArithException, evaluate, try)
+import           Control.Exception (ArithException, SomeException, evaluate, try)
 import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad (unless)
 
-import           Data.Bifunctor (bimap)
+import           Data.Bifunctor (first)
 import           Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros
                             , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor)
-import           Data.Word (Word64, byteSwap64)
+import           Data.Primitive.PrimArray
+import           Data.Primitive.Ptr
+import           Data.Word (Word8, Word64, byteSwap64)
 import           Data.WideWord
 
 import           Foreign (allocaBytes)
@@ -80,22 +83,27 @@
 prop_succ =
   propertyCount $ do
     w128 <- H.forAll genWord128
-    res <- liftIO . try $ evaluate (succ w128)
-    bimap showArithException toInteger128 res
-        === if w128 == maxBound
+    res <- liftIO (fmap toInteger128 <$> tryEvaluate (succ w128))
+    res === if w128 == maxBound
               then Left "Enum.succ{Word128}: tried to take `succ' of maxBound"
-              else Right $ succ (toInteger128 w128)
+              else Right (succ $ toInteger128 w128)
 
 prop_pred :: Property
 prop_pred =
   propertyCount $ do
     w128 <- H.forAll genWord128
-    res <- liftIO . try $ evaluate (pred w128)
-    bimap showArithException toInteger128 res
-        === if w128 == 0
+    res <- liftIO (fmap toInteger128 <$> tryEvaluate (pred w128))
+    res === if w128 == 0
               then Left "Enum.pred{Word128}: tried to take `pred' of minBound"
               else Right $ pred (toInteger128 w128)
 
+tryEvaluate :: a -> IO (Either String a)
+tryEvaluate x = do
+  first renderException <$> try (evaluate x)
+  where
+    renderException :: SomeException -> String
+    renderException = show
+
 prop_toEnum_fromEnum :: Property
 prop_toEnum_fromEnum =
   propertyCount $ do
@@ -304,6 +312,48 @@
                     pokeElemOff ptr 1 b128
                     (,) <$> peekElemOff ptr 0 <*>  peekElemOff ptr 1
     (toInteger128 ar, toInteger128 br) === (toInteger128 a128, toInteger128 b128)
+
+
+prop_ToFromPrimArray :: Property
+prop_ToFromPrimArray =
+  propertyCount $ do
+    as <- H.forAll $
+      Gen.list (fromIntegral <$> (Range.linearBounded :: Range.Range Word8)) genWord128
+    as === primArrayToList (primArrayFromList as)
+
+
+prop_WriteReadPrimArray :: Property
+prop_WriteReadPrimArray =
+  propertyCount $ do
+    as <- H.forAll $ Gen.list (Range.linear 1 256) genWord128
+    unless (null as) $ do
+      let len = length as
+          arr = primArrayFromList as
+      i <- (`mod` len) <$> H.forAll (Gen.int (Range.linear 0 (len - 1)))
+      new <- H.forAll genWord128
+      props <- liftIO $ do
+        marr <- unsafeThawPrimArray arr
+        prev <- readPrimArray marr i
+        let prevProp = prev === (as !! i)
+        writePrimArray marr i new
+        cur <- readPrimArray marr i
+        setPrimArray marr i 1 prev
+        arr' <- unsafeFreezePrimArray marr
+        return [prevProp, cur === new, arr === arr']
+      sequence_ props
+
+prop_readOffPtr_writeOffPtr :: Property
+prop_readOffPtr_writeOffPtr =
+  propertyCount $ do
+    a128 <- H.forAll genWord128
+    b128 <- H.forAll genWord128
+    (ar, br) <- liftIO $
+                  allocaBytes (2 * sizeOf zeroWord128) $ \ ptr -> do
+                    writeOffPtr ptr 0 a128
+                    writeOffPtr ptr 1 b128
+                    (,) <$> readOffPtr ptr 0 <*> readOffPtr ptr 1
+    (ar, br) === (a128, b128)
+
 
 -- -----------------------------------------------------------------------------
 
diff --git a/test/laws.hs b/test/laws.hs
--- a/test/laws.hs
+++ b/test/laws.hs
@@ -7,6 +7,7 @@
 import Data.Proxy (Proxy(Proxy))
 import Data.Bits
 import Foreign.Storable
+import Data.Primitive.Types (Prim)
 
 main :: IO ()
 main = lawsCheckMany allPropsApplied
@@ -19,17 +20,18 @@
 
 allLaws ::
   ( Arbitrary a
+  , Bits a
   , Bounded a
   , Enum a
   , Eq a
+  , FiniteBits a
   , Integral a
   , Ord a
+  , Prim a
   , Read a
+  , Semiring a
   , Show a
   , Storable a
-  , Bits a
-  , FiniteBits a
-  , Semiring a
   ) => Proxy a -> [Laws]
 allLaws p = map ($ p)
   [ bitsLaws
@@ -39,6 +41,7 @@
   , ordLaws
   , semiringLaws
   , storableLaws
+  , primLaws
   ]
 
 instance Arbitrary Word128 where
diff --git a/wide-word.cabal b/wide-word.cabal
--- a/wide-word.cabal
+++ b/wide-word.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                wide-word
-version:             0.1.0.8
+version:             0.1.0.9
 synopsis:            Data types for large but fixed width signed and unsigned integers
 description:
   A library to provide data types for large (ie > 64 bits) but fixed width signed
@@ -23,7 +23,7 @@
 build-type:          Simple
 extra-source-files:  ChangeLog.md
 stability:           provisional
-cabal-version:       >=1.10
+cabal-version:       >= 1.10
 
 library
   default-language:   Haskell2010
@@ -35,9 +35,9 @@
                        Data.WideWord.Word128
                        Data.WideWord.Int128
 
-  build-depends:       base                          >= 4.8         && < 5.0
+  build-depends:       base                          >= 4.8         && < 4.13
                      , deepseq                       >= 1.3         && < 1.5
-                     , primitive                     >= 0.6.4.0     && < 0.7.0.0
+                     , primitive                     >= 0.6.4.0     && < 0.8
 
 test-suite test
   default-language:   Haskell2010
@@ -51,10 +51,11 @@
                       Test.Data.WideWord.Int128
                       Test.Data.WideWord.Word128
 
-  build-depends:       base                          >= 4.8         && < 5.0
+  build-depends:       base
                      , bytestring                    >= 0.10
                      , ghc-prim
-                     , hedgehog                      == 0.6.*
+                     , hedgehog                      == 1.0.*
+                     , primitive
                      , wide-word
 
 test-suite laws
@@ -65,8 +66,9 @@
   main-is:           laws.hs
   hs-source-dirs:    test
 
-  build-depends:       base                          >= 4.8         && < 5.0
-                     , QuickCheck                    >= 2.9.2       && < 2.13
-                     , quickcheck-classes            >= 0.4.0       && < 0.7.0
-                     , semirings                     >= 0.2         && < 0.3
+  build-depends:       base
+                     , QuickCheck                    >= 2.9.2       && < 2.14
+                     , quickcheck-classes            >= 0.4.0       && < 0.6.3
+                     , primitive
+                     , semirings                     >= 0.2         && < 0.6
                      , wide-word