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
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
{-# 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 hiding (word64ToWord#)
import qualified 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)) =
#if __GLASGOW_HASKELL__ >= 904
Word256 (W64# (wordToWord64# s3)) (W64# (wordToWord64# s2)) (W64# (wordToWord64# s1)) (W64# (wordToWord64# s0))
where
!(# c0, s0 #) = plusWord2# (GHC.Prim.word64ToWord# a0) (GHC.Prim.word64ToWord# b0)
!(# c1, s1 #) = plusWord3# (GHC.Prim.word64ToWord# a1) (GHC.Prim.word64ToWord# b1) (c0)
!(# c2, s2 #) = plusWord3# (GHC.Prim.word64ToWord# a2) (GHC.Prim.word64ToWord# b2) c1
!s3 = plusWord3NoCarry# (GHC.Prim.word64ToWord# a3) (GHC.Prim.word64ToWord# 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
#else
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
#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)
|
