    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE MagicHash          #-}
    {-# LANGUAGE UnboxedTuples      #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    module Basement.Types.Word256
        ( Word256(..)
        , (+)
        , (-)
        , (*)
        , quot
        , rem
        , bitwiseAnd
        , bitwiseOr
        , bitwiseXor
        , complement
        , shiftL
        , shiftR
        , rotateL
        , rotateR
        , popCount
        , fromNatural
        ) where

    import           GHC.Prim
    import           GHC.Word
    import           GHC.Types
    import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod)
    import           Data.Bits hiding (complement, popCount, bit, testBit
                                      , rotateL, rotateR, shiftL, shiftR)
    import qualified Data.Bits as Bits
    import           Data.Function (on)
    import           Foreign.C
    import           Foreign.Ptr
    import           Foreign.Storable

    import           Basement.Compat.Base
    import           Basement.Compat.Natural
    import           Basement.Compat.Primitive (bool#)
    import           Basement.Numerical.Conversion
    import           Basement.Numerical.Number

    #include "MachDeps.h"

    -- | 256 bits Word
    data Word256 = Word256 {-# UNPACK #-} !Word64
                           {-# UNPACK #-} !Word64
                           {-# UNPACK #-} !Word64
                           {-# UNPACK #-} !Word64
        deriving (Eq, Typeable)

    instance Show Word256 where
        show w = Prelude.show (toNatural w)
    instance Enum Word256 where
        toEnum i = Word256 0 0 0 $ int64ToWord64 (intToInt64 i)
        fromEnum (Word256 _ _ _ a0) = wordToInt (word64ToWord a0)
        succ (Word256 a3 a2 a1 a0)
            | a0 == maxBound =
                if a1 == maxBound
                    then if a2 == maxBound
                            then Word256 (succ a3) 0 0 0
                            else Word256 a3 (succ a2) 0 0
                    else Word256 a3 a2 (succ a1) 0
            | otherwise      = Word256 a3 a2 a1        (succ a0)
        pred (Word256 a3 a2 a1 a0)
            | a0 == minBound =
                if a1 == minBound
                    then if a2 == minBound
                            then Word256 (pred a3) maxBound maxBound maxBound
                            else Word256 a3 (pred a2) maxBound maxBound
                    else Word256 a3 a2 (pred a1) maxBound
            | otherwise      = Word256 a3 a2 a1        (pred a0)
    instance Bounded Word256 where
        minBound = Word256 minBound minBound minBound minBound
        maxBound = Word256 maxBound maxBound maxBound maxBound
    instance Ord Word256 where
        compare (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
            compareEq a3 b3 $ compareEq a2 b2 $ compareEq a1 b1 $ compare a0 b0
          where compareEq x y next =
                    case compare x y of
                        EQ -> next
                        r  -> r
        (<) (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
            compareLt a3 b3 $ compareLt a2 b2 $ compareLt a1 b1 (a0 < b0)
          where compareLt x y next =
                    case compare x y of
                        EQ -> next
                        r  -> r == LT
    instance Storable Word256 where
        sizeOf _ = 32
        alignment _ = 32
        peek p = Word256 <$> peek (castPtr p            )
                         <*> peek (castPtr p `plusPtr` 8)
                         <*> peek (castPtr p `plusPtr` 16)
                         <*> peek (castPtr p `plusPtr` 24)
        poke p (Word256 a3 a2 a1 a0) = do
            poke (castPtr p             ) a3
            poke (castPtr p `plusPtr` 8 ) a2
            poke (castPtr p `plusPtr` 16) a1
            poke (castPtr p `plusPtr` 24) a0

    instance Integral Word256 where
        fromInteger = literal
    instance HasNegation Word256 where
        negate = complement

    instance IsIntegral Word256 where
        toInteger (Word256 a3 a2 a1 a0) =
            (toInteger a3 `Bits.unsafeShiftL` 192) Bits..|.
            (toInteger a2 `Bits.unsafeShiftL` 128) Bits..|.
            (toInteger a1 `Bits.unsafeShiftL` 64) Bits..|.
            toInteger a0
    instance IsNatural Word256 where
        toNatural (Word256 a3 a2 a1 a0) =
            (toNatural a3 `Bits.unsafeShiftL` 192) Bits..|.
            (toNatural a2 `Bits.unsafeShiftL` 128) Bits..|.
            (toNatural a1 `Bits.unsafeShiftL` 64) Bits..|.
            toNatural a0

    instance Prelude.Num Word256 where
        abs w = w
        signum w@(Word256 a3 a2 a1 a0)
            | a3 == 0 && a2 == 0 && a1 == 0 && a0 == 0 = w
            | otherwise                                = Word256 0 0 0 1
        fromInteger = literal
        (+) = (+)
        (-) = (-)
        (*) = (*)

    instance Bits.Bits Word256 where
        (.&.) = bitwiseAnd
        (.|.) = bitwiseOr
        xor   = bitwiseXor
        complement = complement
        shiftL = shiftL
        shiftR = shiftR
        rotateL = rotateL
        rotateR = rotateR
        bitSize _ = 256
        bitSizeMaybe _ = Just 256
        isSigned _ = False
        testBit = testBit
        bit = bit
        popCount = popCount

    -- | Add 2 Word256
    (+) :: Word256 -> Word256 -> Word256
    #if WORD_SIZE_IN_BITS < 64
    (+) = applyBiWordOnNatural (Prelude.+)
    #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)
      where
        !(# 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
            | bool# (eqWord# carry 0##) = plusWord2# x c
            | otherwise                 =
                case plusWord2# x c of
                    (# carry2, x' #)
                        | bool# (eqWord# carry2 0##) -> (# carry, x' #)
                        | otherwise                  -> (# plusWord# carry carry2, x' #)
          where
            (# carry, x #) = plusWord2# a b
    #endif

    -- temporary available until native operation available
    applyBiWordOnNatural :: (Natural -> Natural -> Natural)
                         -> Word256
                         -> Word256
                         -> Word256
    applyBiWordOnNatural f = (fromNatural .) . (f `on` toNatural)

    -- | Subtract 2 Word256
    (-) :: Word256 -> Word256 -> Word256
    (-) a b
        | a >= b    = applyBiWordOnNatural (Prelude.-) a b
        | otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1

    -- | Multiplication
    (*) :: Word256 -> Word256 -> Word256
    (*) = applyBiWordOnNatural (Prelude.*)

    -- | Division
    quot :: Word256 -> Word256 -> Word256
    quot = applyBiWordOnNatural Prelude.quot

    -- | Modulo
    rem :: Word256 -> Word256 -> Word256
    rem = applyBiWordOnNatural Prelude.rem

    -- | Bitwise and
    bitwiseAnd :: Word256 -> Word256 -> Word256
    bitwiseAnd (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
        Word256 (a3 Bits..&. b3) (a2 Bits..&. b2)  (a1 Bits..&. b1) (a0 Bits..&. b0)

    -- | Bitwise or
    bitwiseOr :: Word256 -> Word256 -> Word256
    bitwiseOr (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
        Word256 (a3 Bits..|. b3) (a2 Bits..|. b2)  (a1 Bits..|. b1) (a0 Bits..|. b0)

    -- | Bitwise xor
    bitwiseXor :: Word256 -> Word256 -> Word256
    bitwiseXor (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =
        Word256 (a3 `Bits.xor` b3) (a2 `Bits.xor` b2)  (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)

    -- | Bitwise complement
    complement :: Word256 -> Word256
    complement (Word256 a3 a2 a1 a0) =
        Word256 (Bits.complement a3) (Bits.complement a2) (Bits.complement a1) (Bits.complement a0)

    -- | Population count
    popCount :: Word256 -> Int
    popCount (Word256 a3 a2 a1 a0) =
        Bits.popCount a3 Prelude.+
        Bits.popCount a2 Prelude.+
        Bits.popCount a1 Prelude.+
        Bits.popCount a0

    -- | Bitwise Shift Left
    shiftL :: Word256 -> Int -> Word256
    shiftL w@(Word256 a3 a2 a1 a0) n
        | n < 0 || n > 255 = Word256 0 0 0 0
        | n == 0           = w
        | n == 64          = Word256 a2 a1 a0 0
        | n == 128         = Word256 a1 a0 0 0
        | n == 192         = Word256 a0 0 0 0
        | n < 64           = mkWordShift a3 a2 a1 a0 n
        | n < 128          = mkWordShift a2 a1 a0 0  (n Prelude.- 64)
        | n < 192          = mkWordShift a1 a0 0  0  (n Prelude.- 128)
        | otherwise        = mkWordShift a0 0  0  0  (n Prelude.- 192)
      where
        mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256
        mkWordShift w x y z s =
            Word256 (comb64 w s x s') (comb64 x s y s') (comb64 y s z s') (z `Bits.unsafeShiftL` s)
          where s' = inv64 s

    -- | Bitwise Shift Right
    shiftR :: Word256 -> Int -> Word256
    shiftR w@(Word256 a3 a2 a1 a0) n
        | n < 0 || n > 255 = Word256 0 0 0 0
        | n == 0           = w
        | n == 64          = Word256 0 a3 a2 a1
        | n == 128         = Word256 0 0 a3 a2
        | n == 192         = Word256 0 0 0 a3
        | n <  64          = mkWordShift a3 a2 a1 a0 n
        | n < 128          = mkWordShift  0 a3 a2 a1 (n Prelude.- 64)
        | n < 192          = mkWordShift  0  0 a3 a2 (n Prelude.- 128)
        | otherwise        = Word256 0 0 0 (a3 `Bits.unsafeShiftR` (n Prelude.- 192))
      where
        mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256
        mkWordShift w x y z s =
            Word256 (w `Bits.unsafeShiftR` s) (comb64 w s' x s) (comb64 x s' y s) (comb64 y s' z s)
          where s' = inv64 s

    -- | Bitwise rotate Left
    rotateL :: Word256 -> Int -> Word256
    rotateL (Word256 a3 a2 a1 a0) n'
        | n == 0    = Word256 a3 a2 a1 a0
        | n == 192  = Word256 a0 a3 a2 a1
        | n == 128  = Word256 a1 a0 a3 a2
        | n == 64   = Word256 a2 a1 a0 a3
        | n < 64    = Word256 (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n))
                              (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n))
        | n < 128   = let n = n Prelude.- 64 in Word256
                              (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))
                              (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n))
        | n < 192   = let n = n Prelude.- 128 in Word256
                              (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n))
                              (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n))
        | otherwise = let n = n Prelude.- 192 in Word256
                              (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n))
                              (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))
      where
        n :: Int
        n | n' >= 0   = n' `Prelude.mod` 256
          | otherwise = 256 Prelude.- (n' `Prelude.mod` 256)

    -- | Bitwise rotate Left
    rotateR :: Word256 -> Int -> Word256
    rotateR w n = rotateL w (256 Prelude.- n)

    inv64 :: Int -> Int
    inv64 i = 64 Prelude.- i

    comb64 :: Word64 -> Int -> Word64 -> Int -> Word64
    comb64 x i y j =
        (x `Bits.unsafeShiftL` i) .|. (y `Bits.unsafeShiftR` j)

    -- | Test bit
    testBit :: Word256 -> Int -> Bool
    testBit (Word256 a3 a2 a1 a0) n
        | n < 0 || n > 255 = False
        | n > 191          = Bits.testBit a3 (n Prelude.- 192)
        | n > 127          = Bits.testBit a2 (n Prelude.- 128)
        | n > 63           = Bits.testBit a1 (n Prelude.- 64)
        | otherwise        = Bits.testBit a0 n

    -- | bit
    bit :: Int -> Word256
    bit n
        | n < 0 || n > 255 = Word256 0 0 0 0
        | n > 191          = Word256 (Bits.bit (n Prelude.- 192)) 0 0 0
        | n > 127          = Word256 0 (Bits.bit (n Prelude.- 128)) 0 0
        | n > 63           = Word256 0 0 (Bits.bit (n Prelude.- 64)) 0
        | otherwise        = Word256 0 0 0 (Bits.bit n)

    literal :: Integer -> Word256
    literal i = Word256
        (Prelude.fromInteger (i `Bits.unsafeShiftR` 192))
        (Prelude.fromInteger (i `Bits.unsafeShiftR` 128))
        (Prelude.fromInteger (i `Bits.unsafeShiftR` 64))
        (Prelude.fromInteger i)

    fromNatural :: Natural -> Word256
    fromNatural n = Word256
        (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 192))
        (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 128))
        (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64))
        (Prelude.fromInteger $ naturalToInteger n)