module Basement.Types.Word128
( Word128(..)
, (+)
, ()
, (*)
, 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"
data Word128 = Word128 !Word64
!Word64
deriving (Eq, Typeable)
instance Show Word128 where
show w = Prelude.show (toNatural w)
instance Enum Word128 where
toEnum i = Word128 0 $ int64ToWord64 (intToInt64 i)
fromEnum (Word128 _ a0) = wordToInt (word64ToWord a0)
succ (Word128 a1 a0)
| a0 == maxBound = Word128 (succ a1) 0
| otherwise = Word128 a1 (succ a0)
pred (Word128 a1 a0)
| a0 == minBound = Word128 (pred a1) maxBound
| otherwise = Word128 a1 (pred a0)
instance Bounded Word128 where
minBound = Word128 minBound minBound
maxBound = Word128 maxBound maxBound
instance Ord Word128 where
compare (Word128 a1 a0) (Word128 b1 b0) =
case compare a1 b1 of
EQ -> compare a0 b0
r -> r
(<) (Word128 a1 a0) (Word128 b1 b0) =
case compare a1 b1 of
EQ -> a0 < b0
r -> r == LT
(<=) (Word128 a1 a0) (Word128 b1 b0) =
case compare a1 b1 of
EQ -> a0 <= b0
r -> r == LT
instance Storable Word128 where
sizeOf _ = 16
alignment _ = 16
peek p = Word128 <$> peek (castPtr p )
<*> peek (castPtr p `plusPtr` 8)
poke p (Word128 a1 a0) = do
poke (castPtr p ) a1
poke (castPtr p `plusPtr` 8) a0
instance Integral Word128 where
fromInteger = literal
instance HasNegation Word128 where
negate = complement
instance IsIntegral Word128 where
toInteger (Word128 a1 a0) =
(toInteger a1 `unsafeShiftL` 64) .|.
toInteger a0
instance IsNatural Word128 where
toNatural (Word128 a1 a0) =
(toNatural a1 `unsafeShiftL` 64) .|.
toNatural a0
instance Prelude.Num Word128 where
abs w = w
signum w@(Word128 a1 a0)
| a1 == 0 && a0 == 0 = w
| otherwise = Word128 0 1
fromInteger = literal
(+) = (+)
() = ()
(*) = (*)
instance Bits.Bits Word128 where
(.&.) = bitwiseAnd
(.|.) = bitwiseOr
xor = bitwiseXor
complement = complement
shiftL = shiftL
shiftR = shiftR
rotateL = rotateL
rotateR = rotateR
bitSize _ = 128
bitSizeMaybe _ = Just 128
isSigned _ = False
testBit = testBit
bit = bit
popCount = popCount
(+) :: Word128 -> Word128 -> Word128
#if WORD_SIZE_IN_BITS < 64
(+) = applyBiWordOnNatural (Prelude.+)
#else
(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# s0)
where
!(# carry, s0 #) = plusWord2# a0 b0
s1 = plusWord# (plusWord# a1 b1) carry
#endif
applyBiWordOnNatural :: (Natural -> Natural -> Natural)
-> Word128
-> Word128
-> Word128
applyBiWordOnNatural f = (fromNatural .) . (f `on` toNatural)
() :: Word128 -> Word128 -> Word128
() a b
| a >= b = applyBiWordOnNatural (Prelude.-) a b
| otherwise = complement $ applyBiWordOnNatural (Prelude.-) b a
(*) :: Word128 -> Word128 -> Word128
(*) = applyBiWordOnNatural (Prelude.*)
quot :: Word128 -> Word128 -> Word128
quot = applyBiWordOnNatural Prelude.quot
rem :: Word128 -> Word128 -> Word128
rem = applyBiWordOnNatural Prelude.rem
bitwiseAnd :: Word128 -> Word128 -> Word128
bitwiseAnd (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 .&. b1) (a0 .&. b0)
bitwiseOr :: Word128 -> Word128 -> Word128
bitwiseOr (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 .|. b1) (a0 .|. b0)
bitwiseXor :: Word128 -> Word128 -> Word128
bitwiseXor (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)
complement :: Word128 -> Word128
complement (Word128 a1 a0) = Word128 (Bits.complement a1) (Bits.complement a0)
popCount :: Word128 -> Int
popCount (Word128 a1 a0) = Bits.popCount a1 Prelude.+ Bits.popCount a0
shiftL :: Word128 -> Int -> Word128
shiftL w@(Word128 a1 a0) n
| n < 0 || n > 127 = Word128 0 0
| n == 64 = Word128 a0 0
| n == 0 = w
| n > 64 = Word128 (a0 `Bits.unsafeShiftL` (n Prelude.- 64)) 0
| otherwise = Word128 ((a1 `Bits.unsafeShiftL` n) .|. (a0 `Bits.unsafeShiftR` (64 Prelude.- n)))
(a0 `Bits.unsafeShiftL` n)
shiftR :: Word128 -> Int -> Word128
shiftR w@(Word128 a1 a0) n
| n < 0 || n > 127 = Word128 0 0
| n == 64 = Word128 0 a1
| n == 0 = w
| n > 64 = Word128 0 (a1 `Bits.unsafeShiftR` (n Prelude.- 64))
| otherwise = Word128 (a1 `Bits.unsafeShiftR` n)
((a1 `Bits.unsafeShiftL` (inv64 n)) .|. (a0 `Bits.unsafeShiftR` n))
rotateL :: Word128 -> Int -> Word128
rotateL (Word128 a1 a0) n'
| n == 0 = Word128 a1 a0
| n == 64 = Word128 a0 a1
| n < 64 = Word128 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a1 (inv64 n))
| otherwise = let n = n Prelude.- 64 in Word128 (comb64 a0 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))
where
n :: Int
n | n' >= 0 = n' `Prelude.mod` 128
| otherwise = 128 Prelude.- (n' `Prelude.mod` 128)
rotateR :: Word128 -> Int -> Word128
rotateR w n = rotateL w (128 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)
testBit :: Word128 -> Int -> Bool
testBit (Word128 a1 a0) n
| n < 0 || n > 127 = False
| n > 63 = Bits.testBit a1 (n Prelude.- 64)
| otherwise = Bits.testBit a0 n
bit :: Int -> Word128
bit n
| n < 0 || n > 127 = Word128 0 0
| n > 63 = Word128 (Bits.bit (n Prelude.- 64)) 0
| otherwise = Word128 0 (Bits.bit n)
literal :: Integer -> Word128
literal i = Word128
(Prelude.fromInteger (i `Bits.unsafeShiftR` 64))
(Prelude.fromInteger i)
fromNatural :: Natural -> Word128
fromNatural n = Word128
(Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64))
(Prelude.fromInteger $ naturalToInteger n)