{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-----------------------------------------------------------------------------
---- |
---- Module      :  Data.WideWord.Word256
----
---- Maintainer  :  erikd@mega-nerd.com
---- Stability   :  experimental
---- Portability :  non-portable (GHC extensions and primops)
----
---- This module provides an opaque unsigned 256 bit value with the usual set
---- of typeclass instances one would expect for a fixed width unsigned integer
---- type.
---- Operations like addition, subtraction and multiplication etc provide a
---- "modulo 2^256" result as one would expect from a fixed width unsigned word.
-------------------------------------------------------------------------------

module Data.WideWord.Word256
  ( Word256 (..)
  , showHexWord256
  , zeroWord256
  ) where

import Control.DeepSeq (NFData (..))

import Data.Bits (Bits (..), FiniteBits (..), shiftL)
import Data.Data (Data, Typeable)
import Data.Ix (Ix)
#if ! MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif

import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable (..))

import GHC.Base (Int (..))
import GHC.Enum (predError, succError)
import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#)
import GHC.Generics (Generic)
import GHC.Real ((%))
import GHC.Word (Word32, Word64)

import Data.WideWord.Word64

import Numeric (showHex)

import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#)
import Data.Hashable (Hashable,hashWithSalt)

{- HLINT ignore "Use guards" -}

data Word256 = Word256
  { word256hi :: !Word64
  , word256m1 :: !Word64
  , word256m0 :: !Word64
  , word256lo :: !Word64
  }
  deriving (Eq, Data, Generic, Ix, Typeable)

instance Hashable Word256 where
  hashWithSalt s (Word256 a1 a2 a3 a4) =
    s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4

showHexWord256 :: Word256 -> String
showHexWord256 (Word256 a3 a2 a1 a0)
  | a3 == 0 =
      if a2 == 0
        then if a1 == 0
          then showHex a0 ""
          else showHex a1 zeros0 ++ showHex a0 ""
        else showHex a2 zeros1 ++ showHex a1 zeros0 ++ showHex a0 ""
  | otherwise =
         showHex a3 zeros2 ++ showHex a2 zeros1
      ++ showHex a1 zeros0 ++ showHex a0 ""
  where
    h0 = showHex a0 ""
    h1 = showHex a1 ""
    h2 = showHex a2 ""
    zeros0 = replicate (16 - length h0) '0'
    zeros1 = replicate (16 - length h1) '0'
    zeros2 = replicate (16 - length h2) '0'

instance Show Word256 where
  show = show . toInteger256

instance Read Word256 where
  readsPrec p s = [(fromInteger256 (x :: Integer), r) | (x, r) <- readsPrec p s]

instance Ord Word256 where
  compare = compare256

instance Bounded Word256 where
  minBound = zeroWord256
  maxBound = Word256 maxBound maxBound maxBound maxBound

instance Enum Word256 where
  succ = succ256
  pred = pred256
  toEnum = toEnum256
  fromEnum = fromEnum256

instance Num Word256 where
  (+) = plus256
  (-) = minus256
  (*) = times256
  negate = negate256
  abs = id
  signum = signum256
  fromInteger = fromInteger256

instance Bits Word256 where
  (.&.) = and256
  (.|.) = or256
  xor = xor256
  complement = complement256
  shiftL = shiftL256
  unsafeShiftL = shiftL256
  shiftR = shiftR256
  unsafeShiftR = shiftR256
  rotateL = rotateL256
  rotateR = rotateR256

  bitSize _ = 256
  bitSizeMaybe _ = Just 256
  isSigned _ = False

  testBit = testBit256
  bit = bit256

  popCount = popCount256

instance FiniteBits Word256 where
  finiteBitSize _ = 256
  countLeadingZeros = countLeadingZeros256
  countTrailingZeros = countTrailingZeros256

instance Real Word256 where
  toRational x = toInteger256 x % 1

-- For unsigned values, quotRem is the same as divMod.
instance Integral Word256 where
  quot n d = fst (quotRem256 n d)
  rem n d = snd (quotRem256 n d)
  div n d = fst (quotRem256 n d)
  mod n d = snd (quotRem256 n d)
  quotRem = quotRem256
  divMod = quotRem256
  toInteger = toInteger256

instance Storable Word256 where
  sizeOf w = I# (sizeOf256# w)
  alignment w = I# (alignment256# w)
  peek = peek256
  peekElemOff = peekElemOff256
  poke = poke256
  pokeElemOff = pokeElemOff256

instance NFData Word256 where
  -- The fields are already strict and unpacked, so do nothing.
  rnf !_ = ()

instance Prim Word256 where
  sizeOf#         = sizeOf256#
  alignment#      = alignment256#
  indexByteArray# = indexByteArray256#
  readByteArray#  = readByteArray256#
  writeByteArray# = writeByteArray256#
  setByteArray#   = setByteArray256#
  indexOffAddr#   = indexOffAddr256#
  readOffAddr#    = readOffAddr256#
  writeOffAddr#   = writeOffAddr256#
  setOffAddr#     = setOffAddr256#
  {-# INLINE sizeOf# #-}
  {-# INLINE alignment# #-}
  {-# INLINE indexByteArray# #-}
  {-# INLINE readByteArray# #-}
  {-# INLINE writeByteArray# #-}
  {-# INLINE setByteArray# #-}
  {-# INLINE indexOffAddr# #-}
  {-# INLINE readOffAddr# #-}
  {-# INLINE writeOffAddr# #-}
  {-# INLINE setOffAddr# #-}

-- -----------------------------------------------------------------------------
-- Rewrite rules.

{-# RULES
"fromIntegral :: Word256 -> Word256" fromIntegral = id :: Word256 -> Word256

"fromIntegral :: Int -> Word256"     fromIntegral = fromInt
"fromIntegral :: Word -> Word256"    fromIntegral = fromWord
"fromIntegral :: Word32 -> Word256"  fromIntegral = fromWord32
"fromIntegral :: Word64 -> Word256"  fromIntegral = Word256 0 0 0

"fromIntegral :: Word256 -> Int"     fromIntegral = toInt
"fromIntegral :: Word256 -> Word"    fromIntegral = toWord
"fromIntegral :: Word256 -> Word32"  fromIntegral = toWord32
"fromIntegral :: Word256 -> Word64"  fromIntegral = \(Word256 _ _ _ w) -> w
  #-}

{-# INLINE fromInt #-}
fromInt :: Int -> Word256
fromInt = Word256 0 0 0 . fromIntegral

{-# INLINE fromWord #-}
fromWord :: Word -> Word256
fromWord = Word256 0 0 0 . fromIntegral

{-# INLINE fromWord32 #-}
fromWord32 :: Word32 -> Word256
fromWord32 = Word256 0 0 0 . fromIntegral

{-# INLINE toInt #-}
toInt :: Word256 -> Int
toInt (Word256 _ _ _ w) = fromIntegral w

{-# INLINE toWord #-}
toWord :: Word256 -> Word
toWord (Word256 _ _ _ w) = fromIntegral w

{-# INLINE toWord32 #-}
toWord32 :: Word256 -> Word32
toWord32 (Word256 _ _ _ w) = fromIntegral w

-- -----------------------------------------------------------------------------
-- Functions for `Ord` instance.

compare256 :: Word256 -> Word256 -> Ordering
compare256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
  compare a3 b3 <> compare a2 b2 <> compare a1 b1 <> compare a0 b0

-- -----------------------------------------------------------------------------
-- Functions for `Enum` instance.

succ256 :: Word256 -> Word256
succ256 (Word256 a3 a2 a1 a0)
  | a0 == maxBound =
      if a1 == maxBound
        then if a2 == maxBound
          then if a3 == maxBound
            then succError "Word256"
            else Word256 (a3 + 1) 0 0 0
          else Word256 a3 (a2 + 1) 0 0
        else Word256 a3 a2 (a1 + 1) 0
  | otherwise = Word256 a3 a2 a1 (a0 + 1)


pred256 :: Word256 -> Word256
pred256 (Word256 a3 a2 a1 a0)
  | a0 == 0 =
      if a1 == 0
        then if a2 == 0
          then if a3 == 0
            then predError "Word256"
            else Word256 (a3 - 1) maxBound maxBound maxBound
          else Word256 a3 (a2 - 1) maxBound maxBound
        else Word256 a3 a2 (a1 - 1) maxBound
  | otherwise = Word256 a3 a2 a1 (a0 - 1)


{-# INLINABLE toEnum256 #-}
toEnum256 :: Int -> Word256
toEnum256 i = Word256 0 0 0 (toEnum i)

{-# INLINABLE fromEnum256 #-}
fromEnum256 :: Word256 -> Int
fromEnum256 (Word256 _ _ _ a0) = fromEnum a0

-- -----------------------------------------------------------------------------
-- Functions for `Num` instance.

{-# INLINABLE plus256 #-}
plus256 :: Word256 -> Word256 -> Word256
plus256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
    Word256 s3 s2 s1 s0
  where
    !(c1, s0) = plusCarrySum a0 b0
    !(c2a, s1a) = plusCarrySum a1 b1
    !(c2b, s1) = plusCarrySum s1a c1
    !c2 = c2a + c2b
    !(c3a, s2a) = plusCarrySum a2 b2
    !(c3b, s2) = plusCarrySum s2a c2
    !c3 = c3a + c3b
    !s3 = a3 + b3 + c3

{-# INLINABLE minus256 #-}
minus256 :: Word256 -> Word256 -> Word256
minus256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
    Word256 s3 s2 s1 s0
  where
    !(v1, s0) = subCarryDiff a0 b0
    !(v2, s1) =
      if v1 == 0
        then subCarryDiff a1 b1
        else if a1 == 0
          then (0xFFFFFFFFFFFFFFFF - b1, 1)
          else subCarryDiff (a1 - 1) b1
    !(v3, s2) =
      if v2 == 0
        then subCarryDiff a2 b2
        else if a1 == 0
          then (0xFFFFFFFFFFFFFFFF - b2, 1)
          else subCarryDiff (a2 - 1) b2
    !s3 =
      if v3 == 0
        then a3 - b3
        else (a3 - 1) - b3

times256 :: Word256 -> Word256 -> Word256
times256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
    Word256 r3 r2 r1 r0
  where
    !(c00, p00) = timesCarryProd a0 b0
    !(c01, p01) = timesCarryProd a0 b1
    !(c02, p02) = timesCarryProd a0 b2
    !p03 = a0 * b3
    !(c10, p10) = timesCarryProd a1 b0
    !(c11, p11) = timesCarryProd a1 b1
    !p12 = a1 * b2
    !(c20, p20) = timesCarryProd a2 b0
    !p21 = a2 * b1
    !p30 = a3 * b0
    !r0 = p00
    !c1 = c00
    !(c2x, r1a) = plusCarrySum p01 p10
    !(c2y, r1b) = plusCarrySum r1a c1
    !(c3w, c2) = plusCarrySum c2x c2y
    !r1 = r1b
    !(c3x, r2a) = plusCarrySum p11 p20
    !(c3y, r2b) = plusCarrySum p02 r2a
    !(c3z, r2c) = plusCarrySum r2b c2
    !(c3s, r2d) = plusCarrySum r2c c01
    !(c3t, r2e) = plusCarrySum r2d c10
    !r2 = r2e
    !r3 = p30 + p21 + p12 + p03 + c3w + c3x +
           c3y + c3z + c3s + c3t + c02 + c11 + c20

{-# INLINABLE negate256 #-}
negate256 :: Word256 -> Word256
negate256 (Word256 a3 a2 a1 a0) =
  case plusCarrySum (complement a0) 1 of
    (c1, s0) -> case plusCarrySum (complement a1) c1 of
      (c2, s1) -> case plusCarrySum (complement a2) c2 of
        (c3, s2) -> case complement a3 + c3 of
          s3 -> Word256 s3 s2 s1 s0

{-# INLINABLE signum256 #-}
signum256 :: Word256 -> Word256
signum256 (Word256 a b c d) =
  if a == 0 && b == 0 && c == 0 && d == 0
    then zeroWord256
    else oneWord256

fromInteger256 :: Integer -> Word256
fromInteger256 i =
  Word256
    (fromInteger $ i `shiftR` 192) (fromInteger $ i `shiftR` 128)
    (fromInteger $ i `shiftR` 64) (fromInteger i)

-- -----------------------------------------------------------------------------
-- Functions for `Bits` instance.

{-# INLINABLE and256 #-}
and256 :: Word256 -> Word256 -> Word256
and256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
  Word256 (a3 .&. b3) (a2 .&. b2) (a1 .&. b1) (a0 .&. b0)

{-# INLINABLE or256 #-}
or256 :: Word256 -> Word256 -> Word256
or256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
  Word256 (a3 .|. b3) (a2 .|. b2) (a1 .|. b1) (a0 .|. b0)

{-# INLINABLE xor256 #-}
xor256 :: Word256 -> Word256 -> Word256
xor256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
  Word256 (xor a3 b3) (xor a2 b2) (xor a1 b1) (xor a0 b0)

{-# INLINABLE complement256 #-}
complement256 :: Word256 -> Word256
complement256 (Word256 a3 a2 a1 a0) =
  Word256 (complement a3) (complement a2) (complement a1) (complement a0)

-- Probably not worth inlining this.
shiftL256 :: Word256 -> Int -> Word256
shiftL256 w@(Word256 a3 a2 a1 a0) s
  | s < 0 || s >= 256 = zeroWord256
  | s == 0 = w
  | s > 192 = Word256 (a0 `shiftL` (s - 192)) 0 0 0
  | s == 192 = Word256 a0 0 0 0
  | s > 128 =
      Word256
        (a1 `shiftL` (s - 128) + a0 `shiftR` (192 - s))
        (a0 `shiftL` (s - 128)) 0 0
  | s == 128 = Word256 a1 a0 0 0
  | s > 64 =
      Word256
        (a2 `shiftL` (s - 64) + a1 `shiftR` (128 - s))
        (a1 `shiftL` (s - 64) + a0 `shiftR` (128 - s))
        (a0 `shiftL` (s - 64))
        0
  | s == 64 = Word256 a2 a1 a0 0
  | otherwise =
      Word256
        (a3 `shiftL` s + a2 `shiftR` (64 - s))
        (a2 `shiftL` s + a1 `shiftR` (64 - s))
        (a1 `shiftL` s + a0 `shiftR` (64 - s))
        (a0 `shiftL` s)

shiftR256 :: Word256 -> Int -> Word256
shiftR256 w@(Word256 a3 a2 a1 a0) s
  | s < 0 = zeroWord256
  | s == 0 = w
  | s >= 256 = zeroWord256
  | s > 192 = Word256 0 0 0 (a3 `shiftR` (s - 192))
  | s == 192 = Word256 0 0 0 a3
  | s > 128 =
      Word256 0 0 (a3 `shiftR` (s - 128)) (a2 `shiftR` (s - 128) + a3 `shiftL` (192 - s))
  | s == 128 = Word256 0 0 a3 a2
  | s > 64 =
      Word256 0 (a3 `shiftR` (s - 64))
        (a2 `shiftR` (s - 64) + a3 `shiftL` (128 - s))
        (a1 `shiftR` (s - 64) + a2 `shiftL` (128 - s))
  | s == 64 = Word256 0 a3 a2 a1
  | otherwise =
      Word256 (a3 `shiftR` s)
        (a2 `shiftR` s + a3 `shiftL` (64 - s))
        (a1 `shiftR` s + a2 `shiftL` (64 - s))
        (a0 `shiftR` s + a1 `shiftL` (64 - s))

rotateL256 :: Word256 -> Int -> Word256
rotateL256 w@(Word256 a3 a2 a1 a0) r
  | r < 0 = zeroWord256
  | r == 0 = w
  | r >= 256 = rotateL256 w (r `mod` 256)
  | r >= 64 = rotateL256 (Word256 a2 a1 a0 a3) (r - 64)
  | otherwise =
      Word256
        (a3 `shiftL` r + a2 `shiftR` (64 - r)) (a2 `shiftL` r + a1 `shiftR` (64 - r))
        (a1 `shiftL` r + a0 `shiftR` (64 - r)) (a0 `shiftL` r + a3 `shiftR` (64 - r))

rotateR256 :: Word256 -> Int -> Word256
rotateR256 w@(Word256 a3 a2 a1 a0) r
  | r < 0 = rotateR256 w (256 - (abs r `mod` 256))
  | r == 0 = w
  | r >= 256 = rotateR256 w (r `mod` 256)
  | r >= 64 = rotateR256 (Word256 a0 a3 a2 a1) (r - 64)
  | otherwise =
      Word256
        (a3 `shiftR` r + a0 `shiftL` (64 - r)) (a2 `shiftR` r + a3 `shiftL` (64 - r))
        (a1 `shiftR` r + a2 `shiftL` (64 - r)) (a0 `shiftR` r + a1 `shiftL` (64 - r))

testBit256 :: Word256 -> Int -> Bool
testBit256 (Word256 a3 a2 a1 a0) i
  | i < 0 = False
  | i >= 256 = False
  | i >= 192 = testBit a3 (i - 192)
  | i >= 128 = testBit a2 (i - 128)
  | i >= 64 = testBit a1 (i - 64)
  | otherwise = testBit a0 i

bit256 :: Int -> Word256
bit256 indx
  | indx < 0 = zeroWord256
  | indx >= 256 = zeroWord256
  | otherwise = shiftL256 oneWord256 indx

popCount256 :: Word256 -> Int
popCount256 (Word256 a3 a2 a1 a0) =
  popCount a3 + popCount a2 + popCount a1 + popCount a0

-- -----------------------------------------------------------------------------
-- Functions for `FiniteBits` instance.

countLeadingZeros256 :: Word256 -> Int
countLeadingZeros256 (Word256 a3 a2 a1 a0) =
  case countLeadingZeros a3 of
    64 -> case countLeadingZeros a2 of
      64 -> case countLeadingZeros a1 of
        64 -> 192 + countLeadingZeros a0
        res -> 128 + res
      res -> 64 + res
    res -> res

countTrailingZeros256 :: Word256 -> Int
countTrailingZeros256 (Word256 a3 a2 a1 a0) =
  case countTrailingZeros a0 of
    64 -> case countTrailingZeros a1 of
      64 -> case countTrailingZeros a2 of
        64 -> 192 + countTrailingZeros a3
        res -> 128 + res
      res -> 64 + res
    res -> res

-- -----------------------------------------------------------------------------
-- Functions for `Integral` instance.

-- TODO: This is inefficient, but the better version is rather
-- tedious to write out.
quotRem256 :: Word256 -> Word256 -> (Word256, Word256)
quotRem256 a b =
  let (x,y) = quotRem (toInteger256 a) (toInteger256 b)
   in (fromInteger256 x, fromInteger256 y)

toInteger256 :: Word256 -> Integer
toInteger256 (Word256 a3 a2 a1 a0) =
  (toInteger a3 `shiftL` 192)
    + (toInteger a2 `shiftL` 128)
    + (toInteger a1 `shiftL` 64)
    + toInteger a0

-- -----------------------------------------------------------------------------
-- Functions for `Storable` instance.

peek256 :: Ptr Word256 -> IO Word256
peek256 ptr =
  Word256 <$> peekElemOff (castPtr ptr) index3 <*> peekElemOff (castPtr ptr) index2
    <*> peekElemOff (castPtr ptr) index1 <*> peekElemOff (castPtr ptr) index0

peekElemOff256 :: Ptr Word256 -> Int -> IO Word256
peekElemOff256 ptr idx =
  Word256 <$> peekElemOff (castPtr ptr) (idx2 + index3)
    <*> peekElemOff (castPtr ptr) (idx2 + index2)
    <*> peekElemOff (castPtr ptr) (idx2 + index1)
    <*> peekElemOff (castPtr ptr) (idx2 + index0)
  where
    idx2 = 4 * idx

poke256 :: Ptr Word256 -> Word256 -> IO ()
poke256 ptr (Word256 a3 a2 a1 a0) = do
  pokeElemOff (castPtr ptr) index3 a3
  pokeElemOff (castPtr ptr) index2 a2
  pokeElemOff (castPtr ptr) index1 a1
  pokeElemOff (castPtr ptr) index0 a0

pokeElemOff256 :: Ptr Word256 -> Int -> Word256 -> IO ()
pokeElemOff256 ptr idx (Word256 a3 a2 a1 a0) = do
    pokeElemOff (castPtr ptr) (idx2 + index0) a0
    pokeElemOff (castPtr ptr) (idx2 + index1) a1
    pokeElemOff (castPtr ptr) (idx2 + index2) a2
    pokeElemOff (castPtr ptr) (idx2 + index3) a3
  where
    idx2 = 4 * idx

-- -----------------------------------------------------------------------------
-- Functions for `Prim` instance.

{-# INLINE sizeOf256# #-}
sizeOf256# :: Word256 -> Int#
sizeOf256# _ = 4# *# sizeOf# (0 :: Word64)

{-# INLINE alignment256# #-}
alignment256# :: Word256 -> Int#
alignment256# _ = 4# *# alignment# (0 :: Word64)

{-# INLINE indexByteArray256# #-}
indexByteArray256# :: ByteArray# -> Int# -> Word256
indexByteArray256# arr# i# =
  let i2# = 4# *# i#
      w = indexByteArray# arr# (i2# +# unInt index3)
      x = indexByteArray# arr# (i2# +# unInt index2)
      y = indexByteArray# arr# (i2# +# unInt index1)
      z = indexByteArray# arr# (i2# +# unInt index0)
  in Word256 w x y z

{-# INLINE readByteArray256# #-}
readByteArray256# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word256 #)
readByteArray256# arr# i# =
  \s0 -> case readByteArray# arr# (i2# +# unInt index3) s0 of
    (# s1, w #) -> case readByteArray# arr# (i2# +# unInt index2) s1 of
      (# s2, x #) -> case readByteArray# arr# (i2# +# unInt index1) s2 of
        (# s3, y #) -> case readByteArray# arr# (i2# +# unInt index0) s3 of
          (# s4, z #) -> (# s4, Word256 w x y z #)
  where i2# = 4# *# i#

{-# INLINE writeByteArray256# #-}
writeByteArray256# :: MutableByteArray# s -> Int# -> Word256 -> State# s -> State# s
writeByteArray256# arr# i# (Word256 a b c d) =
  \s0 -> case writeByteArray# arr# (i2# +# unInt index3) a s0 of
    s1 -> case writeByteArray# arr# (i2# +# unInt index2) b s1 of
      s2 -> case writeByteArray# arr# (i2# +# unInt index1) c s2 of
        s3 -> case writeByteArray# arr# (i2# +# unInt index0) d s3 of
          s4 -> s4
  where i2# = 4# *# i#

{-# INLINE setByteArray256# #-}
setByteArray256# :: MutableByteArray# s -> Int# -> Int# -> Word256 -> State# s -> State# s
setByteArray256# = defaultSetByteArray#

{-# INLINE indexOffAddr256# #-}
indexOffAddr256# :: Addr# -> Int# -> Word256
indexOffAddr256# arr# i# =
  let i2# = 4# *# i#
      w = indexOffAddr# arr# (i2# +# unInt index3)
      x = indexOffAddr# arr# (i2# +# unInt index2)
      y = indexOffAddr# arr# (i2# +# unInt index1)
      z = indexOffAddr# arr# (i2# +# unInt index0)
  in Word256 w x y z

{-# INLINE readOffAddr256# #-}
readOffAddr256# :: Addr# -> Int# -> State# s -> (# State# s, Word256 #)
readOffAddr256# arr# i# =
  \s0 -> case readOffAddr# arr# (i2# +# unInt index3) s0 of
    (# s1, w #) -> case readOffAddr# arr# (i2# +# unInt index2) s1 of
      (# s2, x #) -> case readOffAddr# arr# (i2# +# unInt index1) s2 of
        (# s3, y #) -> case readOffAddr# arr# (i2# +# unInt index0) s3 of
          (# s4, z #) -> (# s4, Word256 w x y z #)
  where i2# = 4# *# i#

{-# INLINE writeOffAddr256# #-}
writeOffAddr256# :: Addr# -> Int# -> Word256 -> State# s -> State# s
writeOffAddr256# arr# i# (Word256 a b c d) =
  \s0 -> case writeOffAddr# arr# (i2# +# unInt index3) a s0 of
    s1 -> case writeOffAddr# arr# (i2# +# unInt index2) b s1 of
      s2 -> case writeOffAddr# arr# (i2# +# unInt index1) c s2 of
        s3 -> case writeOffAddr# arr# (i2# +# unInt index0) d s3 of
          s4 -> s4
  where i2# = 4# *# i#

{-# INLINE setOffAddr256# #-}
setOffAddr256# :: Addr# -> Int# -> Int# -> Word256 -> State# s -> State# s
setOffAddr256# = defaultSetOffAddr#

-- -----------------------------------------------------------------------------
-- Constants.

zeroWord256 :: Word256
zeroWord256 = Word256 0 0 0 0

oneWord256 :: Word256
oneWord256 = Word256 0 0 0 1

unInt :: Int -> Int#
unInt (I# i#) = i#

-- Use these indices to get the peek/poke ordering endian correct.
index0, index1, index2, index3 :: Int
#if WORDS_BIGENDIAN
index0 = 3
index1 = 2
index2 = 1
index3 = 0
#else
index0 = 0
index1 = 1
index2 = 2
index3 = 3
#endif