{-# LANGUAGE CPP                #-}
{-# LANGUAGE MagicHash          #-}
{-# LANGUAGE UnboxedTuples      #-}
{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
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"

-- | 128 bits Word
data Word128 = Word128 {-# UNPACK #-} !Word64
                       {-# UNPACK #-} !Word64
    deriving (Word128 -> Word128 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word128 -> Word128 -> Bool
$c/= :: Word128 -> Word128 -> Bool
== :: Word128 -> Word128 -> Bool
$c== :: Word128 -> Word128 -> Bool
Eq, Typeable)

instance Show Word128 where
    show :: Word128 -> String
show Word128
w = forall a. Show a => a -> String
Prelude.show (forall a. IsNatural a => a -> Natural
toNatural Word128
w)
instance Enum Word128 where
    toEnum :: Int -> Word128
toEnum Int
i = Word64 -> Word64 -> Word128
Word128 Word64
0 forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
int64ToWord64 (Int -> Int64
intToInt64 Int
i)
    fromEnum :: Word128 -> Int
fromEnum (Word128 Word64
_ Word64
a0) = Word -> Int
wordToInt (Word64 -> Word
word64ToWord Word64
a0)
    succ :: Word128 -> Word128
succ (Word128 Word64
a1 Word64
a0)
        | Word64
a0 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound = Word64 -> Word64 -> Word128
Word128 (forall a. Enum a => a -> a
succ Word64
a1) Word64
0
        | Bool
otherwise      = Word64 -> Word64 -> Word128
Word128 Word64
a1        (forall a. Enum a => a -> a
succ Word64
a0)
    pred :: Word128 -> Word128
pred (Word128 Word64
a1 Word64
a0)
        | Word64
a0 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = Word64 -> Word64 -> Word128
Word128 (forall a. Enum a => a -> a
pred Word64
a1) forall a. Bounded a => a
maxBound
        | Bool
otherwise      = Word64 -> Word64 -> Word128
Word128 Word64
a1        (forall a. Enum a => a -> a
pred Word64
a0)
instance Bounded Word128 where
    minBound :: Word128
minBound = Word64 -> Word64 -> Word128
Word128 forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound
    maxBound :: Word128
maxBound = Word64 -> Word64 -> Word128
Word128 forall a. Bounded a => a
maxBound forall a. Bounded a => a
maxBound
instance Ord Word128 where
    compare :: Word128 -> Word128 -> Ordering
compare (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
        case forall a. Ord a => a -> a -> Ordering
compare Word64
a1 Word64
b1 of
            Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare Word64
a0 Word64
b0
            Ordering
r  -> Ordering
r
    < :: Word128 -> Word128 -> Bool
(<) (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
        case forall a. Ord a => a -> a -> Ordering
compare Word64
a1 Word64
b1 of
            Ordering
EQ -> Word64
a0 forall a. Ord a => a -> a -> Bool
< Word64
b0
            Ordering
r  -> Ordering
r forall a. Eq a => a -> a -> Bool
== Ordering
LT
    <= :: Word128 -> Word128 -> Bool
(<=) (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
        case forall a. Ord a => a -> a -> Ordering
compare Word64
a1 Word64
b1 of
            Ordering
EQ -> Word64
a0 forall a. Ord a => a -> a -> Bool
<= Word64
b0
            Ordering
r  -> Ordering
r forall a. Eq a => a -> a -> Bool
== Ordering
LT
instance Storable Word128 where
    sizeOf :: Word128 -> Int
sizeOf Word128
_ = Int
16
    alignment :: Word128 -> Int
alignment Word128
_ = Int
16
    peek :: Ptr Word128 -> IO Word128
peek Ptr Word128
p = Word64 -> Word64 -> Word128
Word128 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128
p            )
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
    poke :: Ptr Word128 -> Word128 -> IO ()
poke Ptr Word128
p (Word128 Word64
a1 Word64
a0) = do
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128
p            ) Word64
a1
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word128
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Word64
a0

instance Integral Word128 where
    fromInteger :: Integer -> Word128
fromInteger = Integer -> Word128
literal
instance HasNegation Word128 where
    negate :: Word128 -> Word128
negate = Word128 -> Word128
complement

instance IsIntegral Word128 where
    toInteger :: Word128 -> Integer
toInteger (Word128 Word64
a1 Word64
a0) =
        (forall a. IsIntegral a => a -> Integer
toInteger Word64
a1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
64) forall a. Bits a => a -> a -> a
.|.
        forall a. IsIntegral a => a -> Integer
toInteger Word64
a0
instance IsNatural Word128 where
    toNatural :: Word128 -> Natural
toNatural (Word128 Word64
a1 Word64
a0) =
        (forall a. IsNatural a => a -> Natural
toNatural Word64
a1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
64) forall a. Bits a => a -> a -> a
.|.
        forall a. IsNatural a => a -> Natural
toNatural Word64
a0

instance Prelude.Num Word128 where
    abs :: Word128 -> Word128
abs Word128
w = Word128
w
    signum :: Word128 -> Word128
signum w :: Word128
w@(Word128 Word64
a1 Word64
a0)
        | Word64
a1 forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& Word64
a0 forall a. Eq a => a -> a -> Bool
== Word64
0 = Word128
w
        | Bool
otherwise          = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
1
    fromInteger :: Integer -> Word128
fromInteger = Integer -> Word128
literal
    + :: Word128 -> Word128 -> Word128
(+) = Word128 -> Word128 -> Word128
(+)
    (-) = (-)
    * :: Word128 -> Word128 -> Word128
(*) = Word128 -> Word128 -> Word128
(*)

instance Bits.Bits Word128 where
    .&. :: Word128 -> Word128 -> Word128
(.&.) = Word128 -> Word128 -> Word128
bitwiseAnd
    .|. :: Word128 -> Word128 -> Word128
(.|.) = Word128 -> Word128 -> Word128
bitwiseOr
    xor :: Word128 -> Word128 -> Word128
xor   = Word128 -> Word128 -> Word128
bitwiseXor
    complement :: Word128 -> Word128
complement = Word128 -> Word128
complement
    shiftL :: Word128 -> Int -> Word128
shiftL = Word128 -> Int -> Word128
shiftL
    shiftR :: Word128 -> Int -> Word128
shiftR = Word128 -> Int -> Word128
shiftR
    rotateL :: Word128 -> Int -> Word128
rotateL = Word128 -> Int -> Word128
rotateL
    rotateR :: Word128 -> Int -> Word128
rotateR = Word128 -> Int -> Word128
rotateR
    bitSize :: Word128 -> Int
bitSize Word128
_ = Int
128
    bitSizeMaybe :: Word128 -> Maybe Int
bitSizeMaybe Word128
_ = forall a. a -> Maybe a
Just Int
128
    isSigned :: Word128 -> Bool
isSigned Word128
_ = Bool
False
    testBit :: Word128 -> Int -> Bool
testBit = Word128 -> Int -> Bool
testBit
    bit :: Int -> Word128
bit = Int -> Word128
bit
    popCount :: Word128 -> Int
popCount = Word128 -> Int
popCount

-- | Add 2 Word128
(+) :: Word128 -> Word128 -> Word128
#if WORD_SIZE_IN_BITS < 64
(+) = applyBiWordOnNatural (Prelude.+)
#else
#if __GLASGOW_HASKELL__ >= 904
(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# (wordToWord64# s0))
  where
    !(# carry, s0 #) = plusWord2# (GHC.Prim.word64ToWord# a0) (GHC.Prim.word64ToWord# b0)
    s1               = wordToWord64# (plusWord# (plusWord# (GHC.Prim.word64ToWord# a1) (GHC.Prim.word64ToWord# b1)) carry)
#else
+ :: Word128 -> Word128 -> Word128
(+) (Word128 (W64# Word#
a1) (W64# Word#
a0)) (Word128 (W64# Word#
b1) (W64# Word#
b0)) = Word64 -> Word64 -> Word128
Word128 (Word# -> Word64
W64# Word#
s1) (Word# -> Word64
W64# Word#
s0)
  where
    !(# Word#
carry, Word#
s0 #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
a0 Word#
b0
    s1 :: Word#
s1               = Word# -> Word# -> Word#
plusWord# (Word# -> Word# -> Word#
plusWord# Word#
a1 Word#
b1) Word#
carry
#endif
#endif

-- temporary available until native operation available
applyBiWordOnNatural :: (Natural -> Natural -> Natural)
                     -> Word128
                     -> Word128
                     -> Word128
applyBiWordOnNatural :: (Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural Natural -> Natural -> Natural
f Word128
a Word128
b = Natural -> Word128
fromNatural forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> Natural
f (forall a. IsNatural a => a -> Natural
toNatural Word128
a) (forall a. IsNatural a => a -> Natural
toNatural Word128
b)

-- | Subtract 2 Word128
(-) :: Word128 -> Word128 -> Word128
(-) Word128
a Word128
b
    | Word128
a forall a. Ord a => a -> a -> Bool
>= Word128
b    = (Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural forall a. Num a => a -> a -> a
(Prelude.-) Word128
a Word128
b
    | Bool
otherwise = Word128 -> Word128
complement ((Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural forall a. Num a => a -> a -> a
(Prelude.-) Word128
b Word128
a) Word128 -> Word128 -> Word128
+ Word128
1

-- | Multiplication
(*) :: Word128 -> Word128 -> Word128
* :: Word128 -> Word128 -> Word128
(*) = (Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural forall a. Num a => a -> a -> a
(Prelude.*)

-- | Division
quot :: Word128 -> Word128 -> Word128
quot :: Word128 -> Word128 -> Word128
quot = (Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural forall a. Integral a => a -> a -> a
Prelude.quot

-- | Modulo
rem :: Word128 -> Word128 -> Word128
rem :: Word128 -> Word128 -> Word128
rem = (Natural -> Natural -> Natural) -> Word128 -> Word128 -> Word128
applyBiWordOnNatural forall a. Integral a => a -> a -> a
Prelude.rem

-- | Bitwise and
bitwiseAnd :: Word128 -> Word128 -> Word128
bitwiseAnd :: Word128 -> Word128 -> Word128
bitwiseAnd (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
    Word64 -> Word64 -> Word128
Word128 (Word64
a1 forall a. Bits a => a -> a -> a
.&. Word64
b1) (Word64
a0 forall a. Bits a => a -> a -> a
.&. Word64
b0)

-- | Bitwise or
bitwiseOr :: Word128 -> Word128 -> Word128
bitwiseOr :: Word128 -> Word128 -> Word128
bitwiseOr (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
    Word64 -> Word64 -> Word128
Word128 (Word64
a1 forall a. Bits a => a -> a -> a
.|. Word64
b1) (Word64
a0 forall a. Bits a => a -> a -> a
.|. Word64
b0)

-- | Bitwise xor
bitwiseXor :: Word128 -> Word128 -> Word128
bitwiseXor :: Word128 -> Word128 -> Word128
bitwiseXor (Word128 Word64
a1 Word64
a0) (Word128 Word64
b1 Word64
b0) =
    Word64 -> Word64 -> Word128
Word128 (Word64
a1 forall a. Bits a => a -> a -> a
`Bits.xor` Word64
b1) (Word64
a0 forall a. Bits a => a -> a -> a
`Bits.xor` Word64
b0)

-- | Bitwise complement
complement :: Word128 -> Word128
complement :: Word128 -> Word128
complement (Word128 Word64
a1 Word64
a0) = Word64 -> Word64 -> Word128
Word128 (forall a. Bits a => a -> a
Bits.complement Word64
a1) (forall a. Bits a => a -> a
Bits.complement Word64
a0)

-- | Population count
popCount :: Word128 -> Int
popCount :: Word128 -> Int
popCount (Word128 Word64
a1 Word64
a0) = forall a. Bits a => a -> Int
Bits.popCount Word64
a1 forall a. Num a => a -> a -> a
Prelude.+ forall a. Bits a => a -> Int
Bits.popCount Word64
a0

-- | Bitwise Shift Left
shiftL :: Word128 -> Int -> Word128
shiftL :: Word128 -> Int -> Word128
shiftL w :: Word128
w@(Word128 Word64
a1 Word64
a0) Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> Int
127 = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
0
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
64          = Word64 -> Word64 -> Word128
Word128 Word64
a0 Word64
0
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0           = Word128
w
    | Int
n forall a. Ord a => a -> a -> Bool
>  Int
64          = Word64 -> Word64 -> Word128
Word128 (Word64
a0 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` (Int
n forall a. Num a => a -> a -> a
Prelude.- Int
64)) Word64
0
    | Bool
otherwise        = Word64 -> Word64 -> Word128
Word128 ((Word64
a1 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
n) forall a. Bits a => a -> a -> a
.|. (Word64
a0 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` (Int
64 forall a. Num a => a -> a -> a
Prelude.- Int
n)))
                                 (Word64
a0 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
n)

-- | Bitwise Shift Right
shiftR :: Word128 -> Int -> Word128
shiftR :: Word128 -> Int -> Word128
shiftR w :: Word128
w@(Word128 Word64
a1 Word64
a0) Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> Int
127 = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
0
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
64          = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
a1
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0           = Word128
w
    | Int
n forall a. Ord a => a -> a -> Bool
>  Int
64          = Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64
a1 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` (Int
n forall a. Num a => a -> a -> a
Prelude.- Int
64))
    | Bool
otherwise        = Word64 -> Word64 -> Word128
Word128 (Word64
a1 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
n)
                                 ((Word64
a1 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` (Int -> Int
inv64 Int
n)) forall a. Bits a => a -> a -> a
.|. (Word64
a0 forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
n))

-- | Bitwise rotate Left
rotateL :: Word128 -> Int -> Word128
rotateL :: Word128 -> Int -> Word128
rotateL (Word128 Word64
a1 Word64
a0) Int
n'
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0    = Word64 -> Word64 -> Word128
Word128 Word64
a1 Word64
a0
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
64   = Word64 -> Word64 -> Word128
Word128 Word64
a0 Word64
a1
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
64    = Word64 -> Word64 -> Word128
Word128 (Word64 -> Int -> Word64 -> Int -> Word64
comb64 Word64
a1 Int
n Word64
a0 (Int -> Int
inv64 Int
n)) (Word64 -> Int -> Word64 -> Int -> Word64
comb64 Word64
a0 Int
n Word64
a1 (Int -> Int
inv64 Int
n))
    | Bool
otherwise = let nx :: Int
nx = Int
n forall a. Num a => a -> a -> a
Prelude.- Int
64 in Word64 -> Word64 -> Word128
Word128 (Word64 -> Int -> Word64 -> Int -> Word64
comb64 Word64
a0 Int
nx Word64
a1 (Int -> Int
inv64 Int
nx)) (Word64 -> Int -> Word64 -> Int -> Word64
comb64 Word64
a1 Int
n' Word64
a0 (Int -> Int
inv64 Int
nx))
  where
    n :: Int
    n :: Int
n | Int
n' forall a. Ord a => a -> a -> Bool
>= Int
0   = Int
n' forall a. Integral a => a -> a -> a
`Prelude.mod` Int
128
      | Bool
otherwise = Int
128 forall a. Num a => a -> a -> a
Prelude.- (Int
n' forall a. Integral a => a -> a -> a
`Prelude.mod` Int
128)

-- | Bitwise rotate Left
rotateR :: Word128 -> Int -> Word128
rotateR :: Word128 -> Int -> Word128
rotateR Word128
w Int
n = Word128 -> Int -> Word128
rotateL Word128
w (Int
128 forall a. Num a => a -> a -> a
Prelude.- Int
n)

inv64 :: Int -> Int
inv64 :: Int -> Int
inv64 Int
i = Int
64 forall a. Num a => a -> a -> a
Prelude.- Int
i

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

-- | Test bit
testBit :: Word128 -> Int -> Bool
testBit :: Word128 -> Int -> Bool
testBit (Word128 Word64
a1 Word64
a0) Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> Int
127 = Bool
False
    | Int
n forall a. Ord a => a -> a -> Bool
> Int
63           = forall a. Bits a => a -> Int -> Bool
Bits.testBit Word64
a1 (Int
n forall a. Num a => a -> a -> a
Prelude.- Int
64)
    | Bool
otherwise        = forall a. Bits a => a -> Int -> Bool
Bits.testBit Word64
a0 Int
n

-- | bit
bit :: Int -> Word128
bit :: Int -> Word128
bit Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> Int
127 = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
0
    | Int
n forall a. Ord a => a -> a -> Bool
> Int
63           = Word64 -> Word64 -> Word128
Word128 (forall a. Bits a => Int -> a
Bits.bit (Int
n forall a. Num a => a -> a -> a
Prelude.- Int
64)) Word64
0
    | Bool
otherwise        = Word64 -> Word64 -> Word128
Word128 Word64
0 (forall a. Bits a => Int -> a
Bits.bit Int
n)

literal :: Integer -> Word128
literal :: Integer -> Word128
literal Integer
i = Word64 -> Word64 -> Word128
Word128
    (forall a. Num a => Integer -> a
Prelude.fromInteger (Integer
i forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
64))
    (forall a. Num a => Integer -> a
Prelude.fromInteger Integer
i)

fromNatural :: Natural -> Word128
fromNatural :: Natural -> Word128
fromNatural Natural
n = Word64 -> Word64 -> Word128
Word128
    (forall a. Num a => Integer -> a
Prelude.fromInteger (Natural -> Integer
naturalToInteger Natural
n forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
64))
    (forall a. Num a => Integer -> a
Prelude.fromInteger forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
n)