src/core/integer.slate

   1 prototypes define: #BigInteger
   2   &parents: {Integer. CoercibleNumberMixin. ByteArray}
   3   &basedOn: ByteArray
   4   &slots: {#isNegative -> False.}.
   5 "An unlimited-precision Integer abstraction, stored in bytes."
   6 "Ensure that newSize:, size, at:, and at:put: are appropriately inherited."
   7
   8 BigInteger traits level ::= 1.
   9 "Level of the number type for coercion purposes."
  10
  11 BigInteger traits DigitBitSize ::= 8.
  12 "The number of bits in a BigInteger digit.
  13 NOTE: This should really only be used at compile-time."
  14
  15 i@(Integer traits) intoByte [i bitAnd: 16rFF].
  16 i@(Integer traits) byteShift: n [i bitShift: n * 8].
  17 i@(Integer traits) endianByteAt: n [(i byteShift: n negated) intoByte].
  18
  19 array@(Sequence traits) as: int@(Integer traits) &bigEndian: bigEndian &radix: radix
  20 [| result position |
  21   bigEndian `defaultsTo: lobby isLittleEndian not.
  22   radix `defaultsTo: 256.
  23   result := 0.
  24   position := 1.
  25   bigEndian
  26     ifTrue: [array size - 1 downTo: 0 do:
  27                [| :i | result := (array at: i) * position + result. position *= radix]]
  28     ifFalse: [0 below: array size do:
  29                 [| :i | result := (array at: i) * position + result. position *= radix]].
  30   result
  31 ].
  32
  33 i@(Integer traits) leastGreaterPowerOfTwo
  34 [| power |
  35   power := 1.
  36   [power < i] whileTrue: [power := power << 1].
  37   power
  38 ].
  39
  40 i@(BigInteger traits) lastDigit
  41 [i at: i size - 1].
  42
  43 i@(BigInteger traits) isPositive
  44 [(i isNegative \/ [i isZero]) not].
  45
  46 i@(BigInteger traits) isZero
  47 [i size = 1 /\ [i lastDigit isZero]].
  48
  49 x@(SmallInteger traits) as: i@(BigInteger traits)
  50 [| carry |
  51   result ::= i newSize: x highBit // 8 + 1.
  52   x isNegative
  53     ifTrue:
  54       [carry := 16r100.
  55        result keysDo:
  56          [| :index |
  57           carry := (carry byteShift: -1) + (x bitXor: 16rFF) intoByte.
  58           result at: index put: carry intoByte.
  59           x := x byteShift: -1]]
  60     ifFalse:
  61       [result keysDo:
  62         [| :index |
  63          result at: index put: x intoByte.
  64          x := x byteShift: -1]].
  65   result isNegative := x isNegative.
  66   result
  67 ].
  68
  69 x@(BigInteger traits) canBeASmallInteger
  70 "Answer whether the BigInteger is of a quantity that can fit into a SmallInteger."
  71 [x between: SmallInteger minimumValue and: SmallInteger maximumValue].
  72
  73 x@(BigInteger traits) as: i@(SmallInteger traits)
  74 [| n shift |
  75   x canBeASmallInteger
  76     ifFalse: [error: 'The integer is too large to be a SmallInteger.'].
  77   n := 0.
  78   shift := 0.
  79   x isNegative
  80     ifTrue:
  81       [x do:
  82         [| :digit |
  83           n += (digit negated byteShift: shift).
  84           shift += 1]]
  85     ifFalse:
  86       [x do:
  87         [| :digit |
  88           n += (digit byteShift: shift).
  89           shift += 1]].
  90   n
  91 ].
  92
  93 i@(BigInteger traits) digitSize
  94 [i size].
  95
  96 i@(BigInteger traits) hash
  97 [| result |
  98   result := 0.
  99   i do: [| :digit | result := result bitXor: digit].
 100   result
 101 ].
 102
 103 i1@(BigInteger traits) <=> i2@(BigInteger traits)
 104 "Answer the sign of the comparison of the two arguments. It works by comparing
 105 number of digits, then highest-to-lowest."
 106 [| digit1 digit2 |
 107   (size1 ::= i1 digitSize) < (size2 ::= i2 digitSize) ifTrue: [^ -1].
 108   size2 < size1 ifTrue: [^ 1].
 109   size1 - 1 downTo: 0 do:
 110     [| :index |
 111      (digit2 := (i2 at: index)) = (digit1 := i1 at: index)
 112        ifFalse: [digit1 < digit2 ifTrue: [^ -1] ifFalse: [^ 1]]].
 113   0
 114 ].
 115
 116 i1@(BigInteger traits) < i2@(BigInteger traits)
 117 [
 118   i1 isNegative == i2 isNegative
 119     ifTrue:
 120       [i1 <=> i2 = (i1 isNegative ifTrue: [1] ifFalse: [-1])]
 121     ifFalse: [i1 isNegative]
 122 ].
 123
 124 i1@(BigInteger traits) = i2@(BigInteger traits)
 125 [
 126   i1 isNegative == i2 isNegative /\ [i1 <=> i2 = 0]
 127 ].
 128
 129 i@(BigInteger traits) negated
 130 [
 131   i copy `>> [isNegative := i isNegative not. ]
 132 ].
 133
 134 source@(BigInteger traits) copyInto: target@(BigInteger traits)
 135 [
 136   0 below: (source digitSize min: target digitSize)
 137     do: [| :index | target at: index put: (source at: index)].
 138   target
 139 ].
 140
 141 i@(BigInteger traits) grownTo: newSize
 142 [
 143   i copyInto: (i newSize: newSize)
 144 ].
 145
 146 i@(BigInteger traits) grownBy: n
 147 [
 148   i grownTo: i digitSize + n
 149 ].
 150
 151 i@(BigInteger traits) shrunkToFit
 152 "Check for leading zeroes and return a trimmed copy."
 153 [
 154   (i indexOfLastSatisfying: [| :digit | digit ~= 0])
 155     ifNil: [0]
 156     ifNotNilDo:
 157       [| :nonZero result |
 158        (result := nonZero + 1 = i size
 159           ifTrue: [i]
 160           ifFalse: [i grownTo: nonZero + 1]) canBeASmallInteger
 161          ifTrue: [result as: SmallInteger]
 162          ifFalse: [result]]
 163 ].
 164
 165 i@(Integer traits) shrunkToFit
 166 "Works like BigInteger shrunkToFit."
 167 [i].
 168
 169 i1@(BigInteger traits) logicallyCombineWith: i2@(BigInteger traits) by: logicOp
 170 "Collects the logical (2s-complement) combination, as described by logicOp,
 171 of a BigInteger with another and returns the collected BigInteger result,
 172 shrunken to the smallest applicable size."
 173 [| bigger smaller a b c x y z |
 174   i1 size < i2 size
 175     ifTrue: [smaller := i1. bigger := i2]
 176     ifFalse: [smaller := i2. bigger := i1].
 177   (result ::= bigger newSize: bigger size + 1) isNegative :=
 178     (logicOp
 179       applyWith: (smaller isNegative ifTrue: [1] ifFalse: [0])
 180       with: (bigger isNegative ifTrue: [1] ifFalse: [0])) = 1.
 181   a := 16r100.
 182   b := 16r100.
 183   c := 16r100.
 184   0 below: bigger size
 185     do: [| :index |
 186       x := index < smaller size ifTrue: [smaller at: index] ifFalse: [0].
 187       smaller isNegative
 188         ifTrue:
 189           [a := (a byteShift: -1) + (x bitXor: 16rFF).
 190            x := a intoByte].
 191       y := bigger at: index.
 192       bigger isNegative
 193         ifTrue:
 194           [b := (b byteShift: -1) + (y bitXor: 16rFF).
 195            y := b intoByte].
 196       z := logicOp applyWith: x with: y.
 197       result isNegative
 198         ifTrue:
 199           [c := (c byteShift: -1) + (z bitXor: 16rFF).
 200            z := c intoByte].
 201       result at: index put: z].
 202   x := smaller isNegative ifTrue: [16rFF] ifFalse: [0].
 203   y := bigger isNegative ifTrue: [16rFF] ifFalse: [0].
 204   z := logicOp applyWith: x with: y.
 205   result isNegative
 206     ifTrue:
 207       [c := (c byteShift: -1) + (z bitXor: 16rFF).
 208        z := c intoByte].
 209   result at: bigger size put: z.
 210   result shrunkToFit
 211 ].
 212
 213 i1@(BigInteger traits) bitOr: i2@(BigInteger traits)
 214 [
 215   i1 logicallyCombineWith: i2 by: #bitOr:`er
 216 ].
 217
 218 i1@(BigInteger traits) bitAnd: i2@(BigInteger traits)
 219 [
 220   i1 logicallyCombineWith: i2 by: #bitAnd:`er
 221 ].
 222
 223 i1@(BigInteger traits) bitXor: i2@(BigInteger traits)
 224 [
 225   i1 logicallyCombineWith: i2 by: #bitXor:`er
 226 ].
 227
 228 i1@(BigInteger traits) add: i2@(BigInteger traits)
 229 [| bigger smaller carry sum |
 230   i1 size < i2 size
 231     ifTrue: [smaller := i1. bigger := i2]
 232     ifFalse: [smaller := i2. bigger := i1].
 233   carry := 0.
 234   sum := i1 new &capacity: bigger size. "Sum gets the same sign as i1."
 235   0 below: smaller size
 236     do: [| :index |
 237       carry := (carry byteShift: -1)
 238         + (smaller at: index) + (bigger at: index).
 239       sum at: index put: carry intoByte].
 240   smaller size below: bigger size do:
 241     [| :index |
 242      carry := (carry byteShift: -1)
 243        + (bigger at: index).
 244      sum at: index put: carry intoByte].
 245   carry > 16rFF
 246     ifTrue: [sum := sum grownBy: 1.
 247              sum at: sum size - 1 put: 1].
 248   sum
 249 ].
 250
 251 i1@(BigInteger traits) subtract: i2@(BigInteger traits)
 252 [| bigger smaller diff borrow |
 253   (i1 <=> i2) = -1
 254     ifTrue: [smaller := i1. bigger := i2]
 255     ifFalse: [smaller := i2. bigger := i1].
 256   borrow := 0.
 257   diff := bigger newSameSize.
 258   diff isNegative := i1 isNegative xor: i1 == smaller.
 259   0 below: smaller size
 260     do: [| :index |
 261       borrow := (borrow byteShift: -1)
 262         + (bigger at: index) - (smaller at: index).
 263       diff at: index put: borrow intoByte].
 264   smaller size below: bigger size do:
 265     [| :index |
 266      borrow := (borrow byteShift: -1)
 267         + (bigger at: index).
 268       diff at: index put: borrow intoByte].
 269   diff shrunkToFit
 270 ].
 271
 272 i1@(BigInteger traits) + i2@(BigInteger traits)
 273 [i1 isNegative = i2 isNegative
 274   ifTrue: [i1 add: i2]
 275   ifFalse: [i1 subtract: i2]
 276 ].
 277
 278 i1@(BigInteger traits) - i2@(BigInteger traits)
 279 [i1 isNegative = i2 isNegative
 280   ifTrue: [i1 subtract: i2]
 281   ifFalse: [i1 add: i2]
 282 ].
 283
 284 i1@(BigInteger traits) * i2@(BigInteger traits)
 285 [| carry |
 286   i1 isZero \/ [i2 isZero] ifTrue: [^ 0].
 287   result ::= i1 new &capacity: (i1 highBit + i2 highBit + 1) // 8 + 1.
 288   result isNegative := i1 isNegative xor: i2 isNegative.
 289   i1 doWithIndex:
 290     [| :each1 :index1 |
 291      carry := 0.
 292      i2 doWithIndex:
 293        [| :each2 :index2 |
 294         carry := (carry byteShift: -1) + (each2 * each1) + (result at: index1 + index2).
 295         result at: index1 + index2 put: carry intoByte].
 296      carry > 16rFF
 297        ifTrue:
 298          [result at: index1 + i2 size put: (carry byteShift: -1)]].
 299   result shrunkToFit
 300 ].
 301
 302 i@(BigInteger traits) highBit
 303 "Answer the index of the high-order bit of the argument, or zero if it is zero."
 304 [
 305   (i digitSize - 1) * 8 + i lastDigit highBit
 306 ].
 307
 308 i@(BigInteger traits) lowBit
 309 "Answer the index of the low-order bit of the argument, or zero if it is zero."
 310 [| index |
 311   i isZero
 312     ifTrue: [0]
 313     ifFalse:
 314       [index := 0.
 315        [(i at: index) isZero]
 316          whileTrue: [index += 1].
 317        (i at: index) lowBit + (8 * index)]
 318 ].
 319
 320 i1@(BigInteger traits) add: i2 scaledBy: q at: offset
 321 [| carry |
 322   carry := 0.
 323   i2 do:
 324     [| :digit |
 325       carry := (carry byteShift: -1) + (i1 at: offset) + (digit * q).
 326       i1 at: offset put: carry intoByte.
 327       offset += 1
 328     ].
 329   [carry > 16rFF]
 330     whileTrue:
 331       [carry := (carry byteShift: -1) + (i1 at: offset).
 332         i1 at: offset put: carry intoByte.
 333         offset += 1].
 334   i1
 335 ].
 336
 337 i1@(BigInteger traits) subtract: i2 at: offset
 338 [| borrow |
 339   borrow := 0.
 340   i2 do:
 341     [| :digit |
 342       borrow := (borrow byteShift: -1) + (i1 at: offset) - digit.
 343       i1 at: offset put: borrow intoByte.
 344       offset += 1
 345     ].
 346   borrow < 0
 347     ifTrue:
 348       [borrow := (borrow byteShift: -1) + (i1 at: offset).
 349         i1 at: offset put: borrow intoByte].
 350   i1
 351 ].
 352
 353 i@(BigInteger traits) twosComplement
 354 [| carry |
 355   carry := 16r100.
 356   i doWithIndex:
 357     [| :digit :index |
 358       carry := (carry byteShift: -1) + (digit bitXor: 16rFF).
 359       i at: index put: carry intoByte
 360     ].
 361   carry byteShift: -1
 362 ].
 363
 364 i1@(BigInteger traits) quoRem: i2@(BigInteger traits)
 365 [| quoRem d shift q lastD quo rem |
 366   i1 <=> i2
 367     caseOf:
 368       {
 369         -1 -> [^ {0. i1}].
 370         0 -> [^ {1. 0}]
 371       }.
 372   shift := 7 - (i2 highBit bitAnd: 7).
 373   quoRem := i1 new &capacity: i1 size + 2.
 374   i1 bitShift: shift into: quoRem.
 375   d := i2 newSameSize.
 376   i2 bitShift: shift into: d.
 377   lastD := d lastDigit.
 378   d twosComplement.
 379   quoRem size - 2
 380     downTo: d size
 381     do: [| :index |
 382       q := quoRem at: index.
 383       q := q = lastD
 384         ifTrue: [16rFF]
 385         ifFalse: [(q byteShift: 1) + (quoRem at: index - 1) quo: lastD].
 386       quoRem add: d scaledBy: q at: index - d size.
 387       [(quoRem at: index) = q]
 388         whileFalse:
 389           [quoRem subtract: d at: index - d size.
 390             q -= 1]].
 391   quo := i1 new &capacity: quoRem size - d size.
 392   quo isNegative := i1 isNegative xor: i2 isNegative.
 393   quoRem bitShift: d size * -8 into: quo.
 394   rem := i2 newSameSize.
 395   quoRem at: d size put: 0.
 396   quoRem bitShift: shift negated into: rem.
 397   { quo shrunkToFit. rem shrunkToFit }
 398 ].
 399
 400 i1@(BigInteger traits) / i2@(BigInteger traits)
 401 [
 402   (quoRem ::= i1 quoRem: i2) second isZero "No remainder."
 403     ifTrue: [quoRem first]
 404     ifFalse: [resend] "Make a fraction."
 405 ].
 406
 407 i1@(BigInteger traits) quo: i2@(BigInteger traits)
 408 [
 409   (i1 quoRem: i2) first
 410 ].
 411
 412 _@(SmallInteger traits) quo: _@(BigInteger traits)
 413 [
 414   0
 415 ].
 416
 417 i1@(BigInteger traits) quo: i2@(SmallInteger traits)
 418 [
 419   i2 isZero
 420     ifTrue: [i1 divideByZero]
 421     ifFalse: [i1 quo: (i2 as: BigInteger)]
 422 ].
 423
 424 i1@(BigInteger traits) rem: i2@(BigInteger traits)
 425 [
 426   (i1 quoRem: i2) second
 427 ].
 428
 429 r@(SmallInteger traits) rem: _@(BigInteger traits)
 430 [
 431   r
 432 ].
 433
 434 i1@(BigInteger traits) rem: i2@(SmallInteger traits)
 435 [
 436   i2 isZero
 437     ifTrue: [i1 divideByZero]
 438     ifFalse: [i1 rem: (i2 as: BigInteger)]
 439 ].
 440
 441 i1@(BigInteger traits) quoRem: i2@(SmallInteger traits)
 442 [
 443   i2 isZero
 444     ifTrue: [i1 divideByZero]
 445     ifFalse: [i1 quoRem: (i2 as: BigInteger)]
 446 ].
 447
 448 i@(BigInteger traits) bitShift: n into: result
 449 [| carry |
 450   source ::= n // 8.
 451   offset ::= n \\ 8.
 452   carry := n isNegative /\ [offset isPositive] /\ [-1 - source < i size]
 453     ifTrue: [(i at: -1 - source) bitShift: offset]
 454     ifFalse: [0].
 455   limit ::= i size min: result size - source.
 456   (source negated max: 0) below: limit
 457     do: [| :index |
 458       carry := (carry byteShift: -1) + ((i at: index) bitShift: offset).
 459       result at: index + source put: carry intoByte].
 460   carry > 16rFF /\ [limit + source < result size]
 461     ifTrue: [result at: limit + source put: (carry byteShift: -1)].
 462   result
 463 ].
 464
 465 i@(BigInteger traits) bitShift: n@(SmallInteger traits)
 466 [
 467   i isZero \/ [n isZero] ifTrue: [^ i].
 468   result ::= i new &capacity: (i highBit + n // 8 max: 0) + 1.
 469   i bitShift: n into: result.
 470   i isNegative /\ [i lowBit < n negated]
 471     ifTrue: [result - 1]
 472     ifFalse: [result shrunkToFit]
 473 ].
 474
 475 x@(Integer traits) raisedTo: y mod: n
 476 "Answer the modular exponential. Originally by Jesse Welton (?)."
 477 [| s t u |
 478   s := 1.
 479   t := x.
 480   u := y.
 481   [u isZero]
 482     whileFalse:
 483       [u isOdd ifTrue:
 484          [(s *= t) >= n ifTrue: [s := s \\ n]].
 485        (t *= t) >= n ifTrue: [t := t \\ n].
 486        u := u bitShift: -1].
 487   s
 488 ].
 489
 490 x@(Integer traits) isCongruentWith: y@(Integer traits) mod: n
 491 "This is a straight interpretation of equivalence via modulus.
 492 The selector is ternary because our grammar can't use 'n' as an adverb."
 493 [
 494   (x \\ n) = (y \\ n)
 495 ].
 496
 497 i@(Integer traits) as: a@(BitArray traits)
 498 "Returns a BitArray initialized from the integer"
 499 [
 500   (BitArray new &capacity: i highBit + 2) `>> [| :newA |
 501     keysDo: [| :index | newA at: index put: (i >> index bitAnd: 1) isZero not].
 502   ]
 503 ].