1{-# LANGUAGE CPP                #-}
2{-# LANGUAGE MagicHash          #-}
3{-# LANGUAGE UnboxedTuples      #-}
4{-# LANGUAGE BangPatterns       #-}
5{-# LANGUAGE DeriveDataTypeable #-}
6module Basement.Types.Word128
7    ( Word128(..)
8    , (+)
9    , (-)
10    , (*)
11    , quot
12    , rem
13    , bitwiseAnd
14    , bitwiseOr
15    , bitwiseXor
16    , complement
17    , shiftL
18    , shiftR
19    , rotateL
20    , rotateR
21    , popCount
22    , fromNatural
23    ) where
24
25import           GHC.Prim
26import           GHC.Word
27import           GHC.Types
28import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod)
29import           Data.Bits hiding (complement, popCount, bit, testBit
30                                  , rotateL, rotateR, shiftL, shiftR)
31import qualified Data.Bits as Bits
32import           Data.Function (on)
33import           Foreign.C
34import           Foreign.Ptr
35import           Foreign.Storable
36
37import           Basement.Compat.Base
38import           Basement.Compat.Natural
39import           Basement.Compat.Primitive (bool#)
40import           Basement.Numerical.Conversion
41import           Basement.Numerical.Number
42
43#include "MachDeps.h"
44
45-- | 128 bits Word
46data Word128 = Word128 {-# UNPACK #-} !Word64
47                       {-# UNPACK #-} !Word64
48    deriving (Eq, Typeable)
49
50instance Show Word128 where
51    show w = Prelude.show (toNatural w)
52instance Enum Word128 where
53    toEnum i = Word128 0 $ int64ToWord64 (intToInt64 i)
54    fromEnum (Word128 _ a0) = wordToInt (word64ToWord a0)
55    succ (Word128 a1 a0)
56        | a0 == maxBound = Word128 (succ a1) 0
57        | otherwise      = Word128 a1        (succ a0)
58    pred (Word128 a1 a0)
59        | a0 == minBound = Word128 (pred a1) maxBound
60        | otherwise      = Word128 a1        (pred a0)
61instance Bounded Word128 where
62    minBound = Word128 minBound minBound
63    maxBound = Word128 maxBound maxBound
64instance Ord Word128 where
65    compare (Word128 a1 a0) (Word128 b1 b0) =
66        case compare a1 b1 of
67            EQ -> compare a0 b0
68            r  -> r
69    (<) (Word128 a1 a0) (Word128 b1 b0) =
70        case compare a1 b1 of
71            EQ -> a0 < b0
72            r  -> r == LT
73    (<=) (Word128 a1 a0) (Word128 b1 b0) =
74        case compare a1 b1 of
75            EQ -> a0 <= b0
76            r  -> r == LT
77instance Storable Word128 where
78    sizeOf _ = 16
79    alignment _ = 16
80    peek p = Word128 <$> peek (castPtr p            )
81                     <*> peek (castPtr p `plusPtr` 8)
82    poke p (Word128 a1 a0) = do
83        poke (castPtr p            ) a1
84        poke (castPtr p `plusPtr` 8) a0
85
86instance Integral Word128 where
87    fromInteger = literal
88instance HasNegation Word128 where
89    negate = complement
90
91instance IsIntegral Word128 where
92    toInteger (Word128 a1 a0) =
93        (toInteger a1 `unsafeShiftL` 64) .|.
94        toInteger a0
95instance IsNatural Word128 where
96    toNatural (Word128 a1 a0) =
97        (toNatural a1 `unsafeShiftL` 64) .|.
98        toNatural a0
99
100instance Prelude.Num Word128 where
101    abs w = w
102    signum w@(Word128 a1 a0)
103        | a1 == 0 && a0 == 0 = w
104        | otherwise          = Word128 0 1
105    fromInteger = literal
106    (+) = (+)
107    (-) = (-)
108    (*) = (*)
109
110instance Bits.Bits Word128 where
111    (.&.) = bitwiseAnd
112    (.|.) = bitwiseOr
113    xor   = bitwiseXor
114    complement = complement
115    shiftL = shiftL
116    shiftR = shiftR
117    rotateL = rotateL
118    rotateR = rotateR
119    bitSize _ = 128
120    bitSizeMaybe _ = Just 128
121    isSigned _ = False
122    testBit = testBit
123    bit = bit
124    popCount = popCount
125
126-- | Add 2 Word128
127(+) :: Word128 -> Word128 -> Word128
128#if WORD_SIZE_IN_BITS < 64
129(+) = applyBiWordOnNatural (Prelude.+)
130#else
131(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# s0)
132  where
133    !(# carry, s0 #) = plusWord2# a0 b0
134    s1               = plusWord# (plusWord# a1 b1) carry
135#endif
136
137-- temporary available until native operation available
138applyBiWordOnNatural :: (Natural -> Natural -> Natural)
139                     -> Word128
140                     -> Word128
141                     -> Word128
142applyBiWordOnNatural f a b = fromNatural $ f (toNatural a) (toNatural b)
143
144-- | Subtract 2 Word128
145(-) :: Word128 -> Word128 -> Word128
146(-) a b
147    | a >= b    = applyBiWordOnNatural (Prelude.-) a b
148    | otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1
149
150-- | Multiplication
151(*) :: Word128 -> Word128 -> Word128
152(*) = applyBiWordOnNatural (Prelude.*)
153
154-- | Division
155quot :: Word128 -> Word128 -> Word128
156quot = applyBiWordOnNatural Prelude.quot
157
158-- | Modulo
159rem :: Word128 -> Word128 -> Word128
160rem = applyBiWordOnNatural Prelude.rem
161
162-- | Bitwise and
163bitwiseAnd :: Word128 -> Word128 -> Word128
164bitwiseAnd (Word128 a1 a0) (Word128 b1 b0) =
165    Word128 (a1 .&. b1) (a0 .&. b0)
166
167-- | Bitwise or
168bitwiseOr :: Word128 -> Word128 -> Word128
169bitwiseOr (Word128 a1 a0) (Word128 b1 b0) =
170    Word128 (a1 .|. b1) (a0 .|. b0)
171
172-- | Bitwise xor
173bitwiseXor :: Word128 -> Word128 -> Word128
174bitwiseXor (Word128 a1 a0) (Word128 b1 b0) =
175    Word128 (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)
176
177-- | Bitwise complement
178complement :: Word128 -> Word128
179complement (Word128 a1 a0) = Word128 (Bits.complement a1) (Bits.complement a0)
180
181-- | Population count
182popCount :: Word128 -> Int
183popCount (Word128 a1 a0) = Bits.popCount a1 Prelude.+ Bits.popCount a0
184
185-- | Bitwise Shift Left
186shiftL :: Word128 -> Int -> Word128
187shiftL w@(Word128 a1 a0) n
188    | n < 0 || n > 127 = Word128 0 0
189    | n == 64          = Word128 a0 0
190    | n == 0           = w
191    | n >  64          = Word128 (a0 `Bits.unsafeShiftL` (n Prelude.- 64)) 0
192    | otherwise        = Word128 ((a1 `Bits.unsafeShiftL` n) .|. (a0 `Bits.unsafeShiftR` (64 Prelude.- n)))
193                                 (a0 `Bits.unsafeShiftL` n)
194
195-- | Bitwise Shift Right
196shiftR :: Word128 -> Int -> Word128
197shiftR w@(Word128 a1 a0) n
198    | n < 0 || n > 127 = Word128 0 0
199    | n == 64          = Word128 0 a1
200    | n == 0           = w
201    | n >  64          = Word128 0 (a1 `Bits.unsafeShiftR` (n Prelude.- 64))
202    | otherwise        = Word128 (a1 `Bits.unsafeShiftR` n)
203                                 ((a1 `Bits.unsafeShiftL` (inv64 n)) .|. (a0 `Bits.unsafeShiftR` n))
204
205-- | Bitwise rotate Left
206rotateL :: Word128 -> Int -> Word128
207rotateL (Word128 a1 a0) n'
208    | n == 0    = Word128 a1 a0
209    | n == 64   = Word128 a0 a1
210    | n < 64    = Word128 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a1 (inv64 n))
211    | otherwise = let nx = n Prelude.- 64 in Word128 (comb64 a0 nx a1 (inv64 nx)) (comb64 a1 n' a0 (inv64 nx))
212  where
213    n :: Int
214    n | n' >= 0   = n' `Prelude.mod` 128
215      | otherwise = 128 Prelude.- (n' `Prelude.mod` 128)
216
217-- | Bitwise rotate Left
218rotateR :: Word128 -> Int -> Word128
219rotateR w n = rotateL w (128 Prelude.- n)
220
221inv64 :: Int -> Int
222inv64 i = 64 Prelude.- i
223
224comb64 :: Word64 -> Int -> Word64 -> Int -> Word64
225comb64 x i y j =
226    (x `Bits.unsafeShiftL` i) .|. (y `Bits.unsafeShiftR` j)
227
228-- | Test bit
229testBit :: Word128 -> Int -> Bool
230testBit (Word128 a1 a0) n
231    | n < 0 || n > 127 = False
232    | n > 63           = Bits.testBit a1 (n Prelude.- 64)
233    | otherwise        = Bits.testBit a0 n
234
235-- | bit
236bit :: Int -> Word128
237bit n
238    | n < 0 || n > 127 = Word128 0 0
239    | n > 63           = Word128 (Bits.bit (n Prelude.- 64)) 0
240    | otherwise        = Word128 0 (Bits.bit n)
241
242literal :: Integer -> Word128
243literal i = Word128
244    (Prelude.fromInteger (i `Bits.unsafeShiftR` 64))
245    (Prelude.fromInteger i)
246
247fromNatural :: Natural -> Word128
248fromNatural n = Word128
249    (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64))
250    (Prelude.fromInteger $ naturalToInteger n)
251