Wider.hs (21429B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE MagicHash #-} 4 {-# LANGUAGE NumericUnderscores #-} 5 {-# LANGUAGE PatternSynonyms #-} 6 {-# LANGUAGE ViewPatterns #-} 7 {-# LANGUAGE UnboxedSums #-} 8 {-# LANGUAGE UnboxedTuples #-} 9 {-# LANGUAGE UnliftedNewtypes #-} 10 11 -- | 12 -- Module: Data.Word.Wider 13 -- Copyright: (c) 2025 Jared Tobin 14 -- License: MIT 15 -- Maintainer: Jared Tobin <jared@ppad.tech> 16 -- 17 -- Wider words, consisting of four 'Limb's. 18 19 module Data.Word.Wider ( 20 -- * Four-limb words 21 Wider(..) 22 , wider 23 , to_vartime 24 , from_vartime 25 26 -- * Comparison 27 , eq_vartime 28 , cmp_vartime 29 , cmp# 30 , eq# 31 , lt 32 , lt# 33 , gt 34 , gt# 35 36 -- * Parity 37 , odd# 38 , odd 39 40 -- * Constant-time selection 41 , select 42 , select# 43 44 -- * Bit manipulation 45 , shl1 46 , shr1 47 , shl1_c 48 , shr1_c 49 , shr_limb 50 , shl_limb 51 , shl1_c# 52 , shr1_c# 53 , shr_limb# 54 , shl_limb# 55 , and 56 , and# 57 , or 58 , or# 59 , xor 60 , xor# 61 , not 62 , not# 63 64 -- * Arithmetic 65 , add_o 66 , add_o# 67 , add 68 , add_w# 69 , add_mod 70 , add_mod# 71 , sub 72 , sub_b 73 , sub_b# 74 , sub_mod 75 , sub_mod# 76 , sub_mod_c# 77 , mul 78 , mul_c 79 , mul_c# 80 , sqr 81 , sqr# 82 ) where 83 84 import Control.DeepSeq 85 import Data.Bits ((.|.), (.&.), (.<<.), (.>>.)) 86 import qualified Data.Bits as B 87 import qualified Data.Choice as C 88 import Data.Word.Limb (Limb(..)) 89 import qualified Data.Word.Limb as L 90 import GHC.Exts (Word(..), Int(..), Word#, Int#) 91 import qualified GHC.Exts as Exts 92 import Prelude hiding (div, mod, or, and, not, quot, rem, recip, odd) 93 94 -- utilities ------------------------------------------------------------------ 95 96 fi :: (Integral a, Num b) => a -> b 97 fi = fromIntegral 98 {-# INLINE fi #-} 99 100 -- wider words ---------------------------------------------------------------- 101 102 type Limb4 = (# Limb, Limb, Limb, Limb #) 103 104 pattern L4 :: Word# -> Word# -> Word# -> Word# -> Limb4 105 pattern L4 w0 w1 w2 w3 = (# Limb w0, Limb w1, Limb w2, Limb w3 #) 106 {-# COMPLETE L4 #-} 107 108 -- | Little-endian wider words, consisting of four 'Limbs'. 109 -- 110 -- >>> 1 :: Wider 111 -- 1 112 data Wider = Wider !Limb4 113 114 instance Show Wider where 115 show = show . from_vartime 116 117 -- | Note that 'fromInteger' necessarily runs in variable time due 118 -- to conversion from the variable-size, potentially heap-allocated 119 -- 'Integer' type. 120 instance Num Wider where 121 (+) = add 122 (-) = sub 123 (*) = mul 124 abs = id 125 fromInteger = to_vartime 126 negate w = add (not w) (Wider (L4 1## 0## 0## 0##)) 127 signum (Wider (# l0, l1, l2, l3 #)) = 128 let !(Limb l) = l0 `L.or#` l1 `L.or#` l2 `L.or#` l3 129 !n = C.from_word_nonzero# l 130 !b = C.to_word# n 131 in Wider (L4 b 0## 0## 0##) 132 133 instance NFData Wider where 134 rnf (Wider a) = case a of 135 (# _, _, _, _ #) -> () 136 137 -- comparison ----------------------------------------------------------------- 138 139 eq# 140 :: Limb4 141 -> Limb4 142 -> C.Choice 143 eq# a b = 144 let !(L4 a0 a1 a2 a3) = a 145 !(L4 b0 b1 b2 b3) = b 146 in C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) 147 {-# INLINE eq# #-} 148 149 -- | Compare 'Wider' words for equality in variable time. 150 -- 151 -- >>> eq_vartime 1 0 152 -- False 153 -- >>> eq_vartime 1 1 154 -- True 155 eq_vartime :: Wider -> Wider -> Bool 156 eq_vartime a b = 157 let !(Wider (# a0, a1, a2, a3 #)) = a 158 !(Wider (# b0, b1, b2, b3 #)) = b 159 in (L.eq_vartime# a0 b0) 160 && (L.eq_vartime# a1 b1) 161 && (L.eq_vartime# a2 b2) 162 && (L.eq_vartime# a3 b3) 163 {-# INLINABLE eq_vartime #-} 164 165 lt# 166 :: Limb4 167 -> Limb4 168 -> C.Choice 169 lt# a b = 170 let !(# _, Limb bor #) = sub_b# a b 171 in C.from_full_mask# bor 172 {-# INLINE lt# #-} 173 174 -- | Constant-time less-than comparison between 'Wider' values. 175 -- 176 -- >>> import qualified Data.Choice as CT 177 -- >>> CT.decide (lt 1 2) 178 -- True 179 -- >>> CT.decide (lt 1 1) 180 -- False 181 lt :: Wider -> Wider -> C.Choice 182 lt (Wider a) (Wider b) = lt# a b 183 {-# INLINABLE lt #-} 184 185 gt# 186 :: Limb4 187 -> Limb4 188 -> C.Choice 189 gt# a b = 190 let !(# _, Limb bor #) = sub_b# b a 191 in C.from_full_mask# bor 192 {-# INLINE gt# #-} 193 194 -- | Constant-time greater-than comparison between 'Wider' values. 195 -- 196 -- >>> import qualified Data.Choice as CT 197 -- >>> CT.decide (gt 1 2) 198 -- False 199 -- >>> CT.decide (gt 2 1) 200 -- True 201 gt :: Wider -> Wider -> C.Choice 202 gt (Wider a) (Wider b) = gt# a b 203 {-# INLINABLE gt #-} 204 205 cmp# 206 :: Limb4 207 -> Limb4 208 -> Int# 209 cmp# (# l0, l1, l2, l3 #) (# r0, r1, r2, r3 #) = 210 let !(# w0, b0 #) = L.sub_b# r0 l0 (Limb 0##) 211 !d0 = L.or# (Limb 0##) w0 212 !(# w1, b1 #) = L.sub_b# r1 l1 b0 213 !d1 = L.or# d0 w1 214 !(# w2, b2 #) = L.sub_b# r2 l2 b1 215 !d2 = L.or# d1 w2 216 !(# w3, b3 #) = L.sub_b# r3 l3 b2 217 !d3 = L.or# d2 w3 218 !(Limb w) = L.and# b3 (Limb 2##) 219 !s = Exts.word2Int# w Exts.-# 1# 220 in (Exts.word2Int# (C.to_word# (L.nonzero# d3))) Exts.*# s 221 {-# INLINE cmp# #-} 222 223 -- | Variable-time comparison between 'Wider' words. 224 -- 225 -- The actual comparison here is performed in constant time, but we must 226 -- branch to return an 'Ordering'. 227 -- 228 -- >>> cmp_vartime 1 2 229 -- LT 230 -- >>> cmp_vartime 2 1 231 -- GT 232 -- >>> cmp_vartime 2 2 233 -- EQ 234 cmp_vartime :: Wider -> Wider -> Ordering 235 cmp_vartime (Wider a) (Wider b) = case cmp# a b of 236 1# -> GT 237 0# -> EQ 238 _ -> LT 239 {-# INLINABLE cmp_vartime #-} 240 241 -- construction / conversion -------------------------------------------------- 242 243 -- | Construct a 'Wider' word from four 'Words', provided in 244 -- little-endian order. 245 -- 246 -- >>> wider 1 0 0 0 247 -- 1 248 wider :: Word -> Word -> Word -> Word -> Wider 249 wider (W# w0) (W# w1) (W# w2) (W# w3) = Wider (L4 w0 w1 w2 w3) 250 {-# INLINABLE wider #-} 251 252 -- | Convert an 'Integer' to a 'Wider' word. 253 -- 254 -- >>> to_vartime 1 255 -- 1 256 to_vartime :: Integer -> Wider 257 to_vartime n = 258 let !size = B.finiteBitSize (0 :: Word) 259 !mask = fi (maxBound :: Word) :: Integer 260 !(W# w0) = fi (n .&. mask) 261 !(W# w1) = fi ((n .>>. size) .&. mask) 262 !(W# w2) = fi ((n .>>. (2 * size)) .&. mask) 263 !(W# w3) = fi ((n .>>. (3 * size)) .&. mask) 264 in Wider (L4 w0 w1 w2 w3) 265 {-# INLINABLE to_vartime #-} 266 267 -- | Convert a 'Wider' word to an 'Integer'. 268 -- 269 -- >>> from_vartime 1 270 -- 1 271 from_vartime :: Wider -> Integer 272 from_vartime (Wider (L4 w0 w1 w2 w3)) = 273 fi (W# w3) .<<. (3 * size) 274 .|. fi (W# w2) .<<. (2 * size) 275 .|. fi (W# w1) .<<. size 276 .|. fi (W# w0) 277 where 278 !size = B.finiteBitSize (0 :: Word) 279 {-# INLINABLE from_vartime #-} 280 281 -- constant-time selection----------------------------------------------------- 282 283 select# 284 :: Limb4 -- ^ a 285 -> Limb4 -- ^ b 286 -> C.Choice -- ^ c 287 -> Limb4 -- ^ result 288 select# (L4 a0 a1 a2 a3) (L4 b0 b1 b2 b3) c = 289 let !(# w0, w1, w2, w3 #) = 290 C.select_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) c 291 in L4 w0 w1 w2 w3 292 {-# INLINE select# #-} 293 294 -- | Return a if c is truthy, otherwise return b. 295 -- 296 -- >>> import qualified Data.Choice as C 297 -- >>> select 0 1 (C.true# ()) 298 -- 1 299 select 300 :: Wider -- ^ a 301 -> Wider -- ^ b 302 -> C.Choice -- ^ c 303 -> Wider -- ^ result 304 select (Wider a) (Wider b) c = Wider (select# a b c) 305 {-# INLINABLE select #-} 306 307 -- bit manipulation ----------------------------------------------------------- 308 309 shr1_c# 310 :: Limb4 -- ^ argument 311 -> (# Limb4, C.Choice #) -- ^ result, carry 312 shr1_c# (# w0, w1, w2, w3 #) = 313 let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1# 314 !(# s3, c3 #) = (# L.shr# w3 1#, L.shl# w3 s #) 315 !r3 = L.or# s3 (Limb 0##) 316 !(# s2, c2 #) = (# L.shr# w2 1#, L.shl# w2 s #) 317 !r2 = L.or# s2 c3 318 !(# s1, c1 #) = (# L.shr# w1 1#, L.shl# w1 s #) 319 !r1 = L.or# s1 c2 320 !(# s0, c0 #) = (# L.shr# w0 1#, L.shl# w0 s #) 321 !r0 = L.or# s0 c1 322 !(Limb w) = L.shr# c0 s 323 in (# (# r0, r1, r2, r3 #), C.from_bit# w #) 324 {-# INLINE shr1_c# #-} 325 326 -- | Constant-time 1-bit shift-right with carry, with a 'Choice' 327 -- indicating whether the lowest bit was set. 328 shr1_c :: Wider -> (# Wider, C.Choice #) 329 shr1_c (Wider w) = 330 let !(# r, c #) = shr1_c# w 331 in (# Wider r, c #) 332 {-# INLINABLE shr1_c #-} 333 334 -- | Constant-time 1-bit shift-right. 335 -- 336 -- >>> shr1 2 337 -- 1 338 -- >>> shr1 1 339 -- 0 340 shr1 :: Wider -> Wider 341 shr1 (Wider w) = 342 let !(# r, _ #) = shr1_c# w 343 in Wider r 344 {-# INLINABLE shr1 #-} 345 346 shl1_c# 347 :: Limb4 -- ^ argument 348 -> (# Limb4, C.Choice #) -- ^ result, carry 349 shl1_c# (# w0, w1, w2, w3 #) = 350 let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1# 351 !(# s0, c0 #) = (# L.shl# w0 1#, L.shr# w0 s #) 352 !r0 = L.or# s0 (Limb 0##) 353 !(# s1, c1 #) = (# L.shl# w1 1#, L.shr# w1 s #) 354 !r1 = L.or# s1 c0 355 !(# s2, c2 #) = (# L.shl# w2 1#, L.shr# w2 s #) 356 !r2 = L.or# s2 c1 357 !(# s3, c3 #) = (# L.shl# w3 1#, L.shr# w3 s #) 358 !r3 = L.or# s3 c2 359 !(Limb w) = L.shl# c3 s 360 in (# (# r0, r1, r2, r3 #), C.from_bit# w #) 361 {-# INLINE shl1_c# #-} 362 363 -- | Constant-time 1-bit shift-left with carry, with a 'Choice' indicating 364 -- whether the highest bit was set. 365 shl1_c :: Wider -> (# Wider, C.Choice #) 366 shl1_c (Wider w) = 367 let !(# r, c #) = shl1_c# w 368 in (# Wider r, c #) 369 {-# INLINABLE shl1_c #-} 370 371 -- | Constant-time 1-bit shift-left. 372 -- 373 -- >>> shl1 1 374 -- 2 375 -- >>> shl1 (2 ^ (255 :: Word)) 376 -- 0 377 shl1 :: Wider -> Wider 378 shl1 (Wider w) = 379 let !(# r, _ #) = shl1_c# w 380 in Wider r 381 {-# INLINABLE shl1 #-} 382 383 shr_limb# 384 :: Limb4 385 -> Int# 386 -> (# Limb4, Limb #) 387 shr_limb# (# a0, a1, a2, a3 #) rs = 388 let !ls = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# rs 389 !(# l3, c3 #) = (# L.shr# a3 rs, L.shl# a3 ls #) 390 !(# l2, c2 #) = (# L.or# (L.shr# a2 rs) c3, L.shl# a2 ls #) 391 !(# l1, c1 #) = (# L.or# (L.shr# a1 rs) c2, L.shl# a1 ls #) 392 !(# l0, c0 #) = (# L.or# (L.shr# a0 rs) c1, L.shl# a0 ls #) 393 in (# (# l0, l1, l2, l3 #), c0 #) 394 {-# INLINE shr_limb# #-} 395 396 -- | Shift right by less than the number of bits in a 'Limb' (e.g., by 397 -- a maximum of 63 bits on 64-bit architectures). The shift amount is 398 -- unchecked. 399 -- 400 -- >>> shr_limb 2 1 401 -- 1 402 shr_limb 403 :: Wider -- ^ value 404 -> Int -- ^ right-shift amount (0 < s < WORD_SIZE) 405 -> Wider -- ^ right-shifted value 406 shr_limb (Wider w) (I# s) = 407 let !(# r, _ #) = shr_limb# w s 408 in Wider r 409 {-# INLINABLE shr_limb #-} 410 411 shl_limb# 412 :: Limb4 413 -> Int# 414 -> (# Limb4, Limb #) 415 shl_limb# (# a0, a1, a2, a3 #) ls = 416 let !rs = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# ls 417 !(# l0, c0 #) = (# L.shl# a0 ls, L.shr# a0 rs #) 418 !(# l1, c1 #) = (# L.or# (L.shl# a1 ls) c0, L.shr# a1 rs #) 419 !(# l2, c2 #) = (# L.or# (L.shl# a2 ls) c1, L.shr# a2 rs #) 420 !(# l3, c3 #) = (# L.or# (L.shl# a3 ls) c2, L.shr# a3 rs #) 421 in (# (# l0, l1, l2, l3 #), c3 #) 422 {-# INLINE shl_limb# #-} 423 424 -- | Shift left by less than the number of bits in a 'Limb' (e.g., by 425 -- a maximum of 63 bits on 64-bit architectures). The shift amount is 426 -- unchecked. 427 -- 428 -- >>> shl_limb 2 1 429 -- 1 430 -- >>> shl_limb 1 63 431 -- 9223372036854775808 432 shl_limb 433 :: Wider -- ^ value 434 -> Int -- ^ left-shift amount (0 < s < WORD_SIZE) 435 -> Wider -- ^ left-shifted value 436 shl_limb (Wider w) (I# s) = 437 let !(# r, _ #) = shl_limb# w s 438 in Wider r 439 {-# INLINABLE shl_limb #-} 440 441 and# 442 :: Limb4 443 -> Limb4 444 -> Limb4 445 and# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) = 446 (# L.and# a0 b0, L.and# a1 b1, L.and# a2 b2, L.and# a3 b3 #) 447 {-# INLINE and# #-} 448 449 -- | Binary /and/. 450 -- 451 -- >>> and 1 1 452 -- 1 453 -- >>> and 1 0 454 -- 0 455 and 456 :: Wider -- ^ a 457 -> Wider -- ^ b 458 -> Wider -- ^ a & b 459 and (Wider a) (Wider b) = Wider (and# a b) 460 {-# INLINABLE and #-} 461 462 or# 463 :: Limb4 464 -> Limb4 465 -> Limb4 466 or# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) = 467 (# L.or# a0 b0, L.or# a1 b1, L.or# a2 b2, L.or# a3 b3 #) 468 {-# INLINE or# #-} 469 470 -- | Binary /or/. 471 -- 472 -- >>> or 1 1 473 -- 1 474 -- >>> or 1 0 475 -- 1 476 or 477 :: Wider -- ^ a 478 -> Wider -- ^ b 479 -> Wider -- ^ a | b 480 or (Wider a) (Wider b) = Wider (or# a b) 481 {-# INLINABLE or #-} 482 483 xor# 484 :: Limb4 485 -> Limb4 486 -> Limb4 487 xor# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) = 488 (# L.xor# a0 b0, L.xor# a1 b1, L.xor# a2 b2, L.xor# a3 b3 #) 489 {-# INLINE xor# #-} 490 491 -- | Binary /xor/. 492 -- 493 -- >>> xor 1 1 494 -- 0 495 -- >>> xor 1 0 496 -- 1 497 xor 498 :: Wider -- ^ a 499 -> Wider -- ^ b 500 -> Wider -- ^ a ^ b 501 xor (Wider a) (Wider b) = Wider (xor# a b) 502 {-# INLINABLE xor #-} 503 504 not# 505 :: Limb4 506 -> Limb4 507 not# (# l0, l1, l2, l3 #) = (# L.not# l0, L.not# l1, L.not# l2, L.not# l3 #) 508 {-# INLINE not# #-} 509 510 -- | Binary /not/. 511 -- 512 -- >>> not 0 513 -- 115792089237316195423570985008687907853269984665640564039457584007913129639935 514 -- >>> not (not 0) 515 -- 0 516 not 517 :: Wider -- ^ value 518 -> Wider -- ^ not value 519 not (Wider w) = Wider (not# w) 520 {-# INLINABLE not #-} 521 522 -- addition, subtraction ------------------------------------------------------ 523 524 add_o# 525 :: Limb4 -- ^ augend 526 -> Limb4 -- ^ addend 527 -> (# Limb4, Limb #) -- ^ (# sum, carry bit #) 528 add_o# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) = 529 let !(# s0, c0 #) = L.add_o# a0 b0 530 !(# s1, c1 #) = L.add_c# a1 b1 c0 531 !(# s2, c2 #) = L.add_c# a2 b2 c1 532 !(# s3, c3 #) = L.add_c# a3 b3 c2 533 in (# (# s0, s1, s2, s3 #), c3 #) 534 {-# INLINE add_o# #-} 535 536 -- | Overflowing addition, computing 'a + b', returning the sum and a 537 -- carry bit. 538 -- 539 -- >>> add_o 1 1 540 -- (2,0) 541 -- >>> add_o 1 (2 ^ (256 :: Word) - 1) 542 -- (0,1) 543 add_o 544 :: Wider -- ^ augend 545 -> Wider -- ^ addend 546 -> (Wider, Word) -- ^ (sum, carry bit) 547 add_o (Wider a) (Wider b) = 548 let !(# s, Limb c #) = add_o# a b 549 in (Wider s, W# c) 550 {-# INLINABLE add_o #-} 551 552 add_w# 553 :: Limb4 -- ^ augend 554 -> Limb4 -- ^ addend 555 -> Limb4 -- ^ sum 556 add_w# a b = 557 let !(# c, _ #) = add_o# a b 558 in c 559 {-# INLINE add_w# #-} 560 561 -- | Wrapping addition, computing 'a + b'. 562 -- 563 -- Note that as 'Wider' is an instance of 'Num', you can use '+' to apply 564 -- this function. 565 -- 566 -- >>> add 1 (2 ^ (256 :: Word) - 1) 567 -- 0 568 add 569 :: Wider 570 -> Wider 571 -> Wider 572 add (Wider a) (Wider b) = Wider (add_w# a b) 573 {-# INLINE add #-} 574 575 add_mod# 576 :: Limb4 -- ^ augend 577 -> Limb4 -- ^ addend 578 -> Limb4 -- ^ modulus 579 -> Limb4 -- ^ sum 580 add_mod# a b m = 581 let !(# w, c #) = add_o# a b 582 in sub_mod_c# w c m m 583 {-# INLINE add_mod# #-} 584 585 -- | Modular addition. 586 -- 587 -- Assumes that the sum is less than twice the modulus; this is not 588 -- checked. 589 -- 590 -- >>> add_mod 1 1 3 591 -- 2 592 -- >>> add_mod 1 2 3 593 -- 0 594 add_mod 595 :: Wider -- ^ augend 596 -> Wider -- ^ addend 597 -> Wider -- ^ modulus 598 -> Wider -- ^ sum 599 add_mod (Wider a) (Wider b) (Wider m) = Wider (add_mod# a b m) 600 {-# INLINABLE add_mod #-} 601 602 sub_b# 603 :: Limb4 -- ^ minuend 604 -> Limb4 -- ^ subtrahend 605 -> (# Limb4, Limb #) -- ^ (# diff, borrow mask #) 606 sub_b# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) = 607 let !(# s0, c0 #) = L.sub_b# a0 b0 (Limb 0##) 608 !(# s1, c1 #) = L.sub_b# a1 b1 c0 609 !(# s2, c2 #) = L.sub_b# a2 b2 c1 610 !(# s3, c3 #) = L.sub_b# a3 b3 c2 611 in (# (# s0, s1, s2, s3 #), c3 #) 612 {-# INLINE sub_b# #-} 613 614 -- | Borrowing subtraction, computing 'a - b' and returning the 615 -- difference with a borrow mask. 616 -- 617 -- >>> sub_b 1 1 618 -- (0,0) 619 -- >>> sub_b 0 (2 ^ (256 :: Word) - 1) 620 -- (1,18446744073709551615) 621 sub_b 622 :: Wider -- ^ minuend 623 -> Wider -- ^ subtrahend 624 -> (Wider, Word) -- ^ (difference, borrow mask) 625 sub_b (Wider l) (Wider r) = 626 let !(# d, Limb b #) = sub_b# l r 627 in (Wider d, W# b) 628 {-# INLINABLE sub_b #-} 629 630 -- | Wrapping subtraction, computing 'a - b' and returning the 631 -- difference. 632 -- 633 -- Note that as 'Wider' is an instance of 'Num', you can use '-' to apply 634 -- this function. 635 -- 636 -- >>> sub 1 1 637 -- 0 638 -- >>> sub 0 (2 ^ (256 :: Word) - 1) 639 -- 1 640 sub 641 :: Wider -- ^ minuend 642 -> Wider -- ^ subtrahend 643 -> Wider -- ^ difference 644 sub (Wider a) (Wider b) = 645 let !(# d, _ #) = sub_b# a b 646 in Wider d 647 {-# INLINABLE sub #-} 648 649 sub_mod# 650 :: Limb4 -- ^ minuend 651 -> Limb4 -- ^ subtrahend 652 -> Limb4 -- ^ modulus 653 -> Limb4 -- ^ difference 654 sub_mod# a b (# p0, p1, p2, p3 #) = 655 let !(# o, m #) = sub_b# a b 656 !ba = (# L.and# p0 m, L.and# p1 m, L.and# p2 m, L.and# p3 m #) 657 in add_w# o ba 658 {-# INLINE sub_mod# #-} 659 660 -- | Modular subtraction. Computes a - b mod m. 661 -- 662 -- Assumes that the magnitude of the difference is less than the 663 -- modulus (this is unchecked). 664 -- 665 -- >>> sub_mod 1 1 4 666 -- 0 667 -- >>> sub_mod 2 3 4 668 -- 3 669 sub_mod 670 :: Wider 671 -> Wider 672 -> Wider 673 -> Wider 674 sub_mod (Wider a) (Wider b) (Wider p) = Wider (sub_mod# a b p) 675 {-# INLINABLE sub_mod #-} 676 677 -- | Modular subtraction with carry. Computes (# a, c #) - b mod m. 678 sub_mod_c# 679 :: Limb4 -- ^ minuend 680 -> Limb -- ^ carry bit 681 -> Limb4 -- ^ subtrahend 682 -> Limb4 -- ^ modulus 683 -> Limb4 -- ^ difference 684 sub_mod_c# a c b (# p0, p1, p2, p3 #) = 685 let !(# (# o0, o1, o2, o3 #), bb #) = sub_b# a b 686 !(# _, m #) = L.sub_b# c (Limb 0##) bb 687 !ba = (# L.and# p0 m, L.and# p1 m, L.and# p2 m, L.and# p3 m #) 688 in add_w# (# o0, o1, o2, o3 #) ba 689 {-# INLINE sub_mod_c# #-} 690 691 -- multiplication ------------------------------------------------------------- 692 693 mul_c# 694 :: Limb4 695 -> Limb4 696 -> (# Limb4, Limb4 #) 697 mul_c# (# x0, x1, x2, x3 #) (# y0, y1, y2, y3 #) = 698 let !(# z0, c0_0 #) = L.mac# x0 y0 (Limb 0##) (Limb 0##) 699 !(# s1_0, c1_0 #) = L.mac# x0 y1 (Limb 0##) c0_0 700 !(# z1, c1_1 #) = L.mac# x1 y0 s1_0 (Limb 0##) 701 !(# s2_0, c2_0 #) = L.mac# x0 y2 (Limb 0##) c1_0 702 !(# s2_1, c2_1 #) = L.mac# x1 y1 s2_0 c1_1 703 !(# z2, c2_2 #) = L.mac# x2 y0 s2_1 (Limb 0##) 704 !(# s3_0, c3_0 #) = L.mac# x0 y3 (Limb 0##) c2_0 705 !(# s3_1, c3_1 #) = L.mac# x1 y2 s3_0 c2_1 706 !(# s3_2, c3_2 #) = L.mac# x2 y1 s3_1 c2_2 707 !(# z3, c3_3 #) = L.mac# x3 y0 s3_2 (Limb 0##) 708 !(# s4_0, c4_0 #) = L.mac# x1 y3 (Limb 0##) c3_0 709 !(# s4_1, c4_1 #) = L.mac# x2 y2 s4_0 c3_1 710 !(# s4_2, c4_2 #) = L.mac# x3 y1 s4_1 c3_2 711 !(# w4, c4_3 #) = L.add_c# s4_2 c3_3 (Limb 0##) 712 !(# s5_0, c5_0 #) = L.mac# x2 y3 (Limb 0##) c4_0 713 !(# s5_1, c5_1 #) = L.mac# x3 y2 s5_0 c4_1 714 !(# w5, c5_2 #) = L.add_c# s5_1 c4_2 (Limb 0##) 715 !(# w5f, c5_3 #) = L.add_c# w5 c4_3 (Limb 0##) 716 !(# s6_0, c6_0 #) = L.mac# x3 y3 (Limb 0##) c5_0 717 !(# w6, c6_1 #) = L.add_c# s6_0 c5_1 (Limb 0##) 718 !(# w6f, c6_2 #) = L.add_c# w6 c5_2 (Limb 0##) 719 !(# w6ff, c6_3 #) = L.add_c# w6f c5_3 (Limb 0##) 720 !(# w7, _ #) = L.add_c# c6_0 c6_1 (Limb 0##) 721 !(# w7f, _ #) = L.add_c# w7 c6_2 (Limb 0##) 722 !(# w7ff, _ #) = L.add_c# w7f c6_3 (Limb 0##) 723 in (# (# z0, z1, z2, z3 #), (# w4, w5f, w6ff, w7ff #) #) 724 {-# INLINE mul_c# #-} 725 726 -- | Widening multiplication. 727 -- 728 -- Returns the low and high 'Wider' words of the product, in that 729 -- order. 730 -- 731 -- >>> mul_c 2 3 732 -- (6,0) 733 -- >>> mul_c (2 ^ (256 :: Word) - 1) 2 734 -- (115792089237316195423570985008687907853269984665640564039457584007913129639934,1) 735 mul_c 736 :: Wider 737 -> Wider 738 -> (Wider, Wider) 739 mul_c (Wider a) (Wider b) = 740 let !(# l, h #) = mul_c# a b 741 in (Wider l, Wider h) 742 {-# INLINABLE mul_c #-} 743 744 -- | Wrapping multiplication. 745 -- 746 -- Note that as 'Wider' is an instance of 'Num', you can use '*' to apply 747 -- this function. 748 -- 749 -- >>> mul 1 1 750 -- 1 751 -- >>> mul 1 2 752 -- 2 753 mul 754 :: Wider 755 -> Wider 756 -> Wider 757 mul (Wider a) (Wider b) = 758 let !(# l, _ #) = mul_c# a b 759 in Wider l 760 {-# INLINABLE mul #-} 761 762 sqr# 763 :: Limb4 764 -> (# Limb4, Limb4 #) 765 sqr# (# x0, x1, x2, x3 #) = 766 let !sh = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1# 767 !(# q1_0, c1_0 #) = L.mac# x1 x0 (Limb 0##) (Limb 0##) 768 !r1 = c1_0 769 !(# r2_0, c2_0 #) = L.mac# x2 x0 r1 (Limb 0##) 770 !(# s2_1, c2_1 #) = L.mac# x2 x1 (Limb 0##) c2_0 771 !t2 = c2_1 772 !(# s3_0, c3_0 #) = L.mac# x3 x0 s2_1 (Limb 0##) 773 !(# t3, c3_1 #) = L.mac# x3 x1 t2 c3_0 774 !(# u3, c3_2 #) = L.mac# x3 x2 (Limb 0##) c3_1 775 !v3 = c3_2 776 !(# lo1, car0_1 #) = (# L.shl# q1_0 1#, L.shr# q1_0 sh #) 777 !(# lo2, car0_2 #) = (# L.or# (L.shl# r2_0 1#) car0_1, L.shr# r2_0 sh #) 778 !(# lo3, car0_3 #) = (# L.or# (L.shl# s3_0 1#) car0_2, L.shr# s3_0 sh #) 779 !(# hi0, car1_0 #) = (# L.or# (L.shl# t3 1#) car0_3, L.shr# t3 sh #) 780 !(# hi1, car1_1 #) = (# L.or# (L.shl# u3 1#) car1_0, L.shr# u3 sh #) 781 !(# hi2, car1_2 #) = (# L.or# (L.shl# v3 1#) car1_1, L.shr# v3 sh #) 782 !hi3 = car1_2 783 !(# pf, car2_0 #) = L.mac# x0 x0 (Limb 0##) (Limb 0##) 784 !(# qf, car2_1 #) = L.add_c# lo1 car2_0 (Limb 0##) 785 !(# rf, car2_2 #) = L.mac# x1 x1 lo2 car2_1 786 !(# sf, car2_3 #) = L.add_c# lo3 car2_2 (Limb 0##) 787 !(# tf, car2_4 #) = L.mac# x2 x2 hi0 car2_3 788 !(# uf, car2_5 #) = L.add_c# hi1 car2_4 (Limb 0##) 789 !(# vf, car2_6 #) = L.mac# x3 x3 hi2 car2_5 790 !(# wf, _ #) = L.add_c# hi3 car2_6 (Limb 0##) 791 in (# (# pf, qf, rf, sf #), (# tf, uf, vf, wf #) #) 792 {-# INLINE sqr# #-} 793 794 -- | Widening square. 795 -- 796 -- >>> sqr 2 797 -- (4,0) 798 -- >>> sqr (2 ^ (256 :: Word) - 1) 799 -- (1,115792089237316195423570985008687907853269984665640564039457584007913129639934) 800 sqr :: Wider -> (Wider, Wider) 801 sqr (Wider w) = 802 let !(# l, h #) = sqr# w 803 in (Wider l, Wider h) 804 {-# INLINABLE sqr #-} 805 806 odd# :: Limb4 -> C.Choice 807 odd# (# l, _, _, _ #) = 808 let !(Limb w) = L.and# l (Limb 1##) 809 in C.from_bit# w 810 {-# INLINE odd# #-} 811 812 -- | Check if a 'Wider' is odd, returning a 'Choice'. 813 odd 814 :: Wider 815 -> C.Choice 816 odd (Wider w) = odd# w 817 {-# INLINABLE odd #-} 818