1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
{-# 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 (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
-- | 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 (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
#endif
-- temporary available until native operation available
applyBiWordOnNatural :: (Natural -> Natural -> Natural)
-> Word128
-> Word128
-> Word128
applyBiWordOnNatural f a b = fromNatural $ f (toNatural a) (toNatural b)
-- | Subtract 2 Word128
(-) :: Word128 -> Word128 -> Word128
(-) a b
| a >= b = applyBiWordOnNatural (Prelude.-) a b
| otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1
-- | Multiplication
(*) :: Word128 -> Word128 -> Word128
(*) = applyBiWordOnNatural (Prelude.*)
-- | Division
quot :: Word128 -> Word128 -> Word128
quot = applyBiWordOnNatural Prelude.quot
-- | Modulo
rem :: Word128 -> Word128 -> Word128
rem = applyBiWordOnNatural Prelude.rem
-- | Bitwise and
bitwiseAnd :: Word128 -> Word128 -> Word128
bitwiseAnd (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 .&. b1) (a0 .&. b0)
-- | Bitwise or
bitwiseOr :: Word128 -> Word128 -> Word128
bitwiseOr (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 .|. b1) (a0 .|. b0)
-- | Bitwise xor
bitwiseXor :: Word128 -> Word128 -> Word128
bitwiseXor (Word128 a1 a0) (Word128 b1 b0) =
Word128 (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)
-- | Bitwise complement
complement :: Word128 -> Word128
complement (Word128 a1 a0) = Word128 (Bits.complement a1) (Bits.complement a0)
-- | Population count
popCount :: Word128 -> Int
popCount (Word128 a1 a0) = Bits.popCount a1 Prelude.+ Bits.popCount a0
-- | Bitwise Shift Left
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)
-- | Bitwise Shift Right
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))
-- | Bitwise rotate Left
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 nx = n Prelude.- 64 in Word128 (comb64 a0 nx a1 (inv64 nx)) (comb64 a1 n' a0 (inv64 nx))
where
n :: Int
n | n' >= 0 = n' `Prelude.mod` 128
| otherwise = 128 Prelude.- (n' `Prelude.mod` 128)
-- | Bitwise rotate Left
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)
-- | Test bit
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
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)
|
