requires: {#Integer. #SmallInteger}.
provides: {#BigInteger}.

prototypes addPrototype: #BigInteger derivedFrom: {Integer. ByteArray}.
"An unlimited-precision Integer abstraction, stored in bytes."
"Ensure that newSize:, size, at:, and at:put: are appropriately inherited."
BigInteger addSlot: #isNegative valued: False.
"Whether it's negative."

BigInteger traits addImmutableSlot: #level valued: 1.
"Level of the number type for coercion purposes."

BigInteger traits addImmutableSlot: #DigitBitSize valued: 8.
"The number of bits in a BigInteger digit.
NOTE: This should really only be used at compile-time."

i@(BigInteger traits) lastDigit
[i at: i size - 1].

i@(BigInteger traits) isPositive
[(i isNegative or: [i isZero]) not].

i@(BigInteger traits) isZero
[i size = 1 and: [i lastDigit isZero]].

x@(SmallInteger traits) as: i@(BigInteger traits)
[| newI carry |
  newI: (i newSize: (x highBit // 8 + 1)).
  x isNegative
    ifTrue:
      [carry: 16r100.
        0 below: newI size
          do:
            [| :index |
              carry: (carry bitShift: -8) + ((x bitXor: 16rFF) bitAnd: 16rFF).
              newI at: index put: (carry bitAnd: 16rFF).
              x: (x bitShift: -8)
            ]]
    ifFalse:
      [0 below: newI size
        do:
          [| :index |
            newI at: index put: (x bitAnd: 16rFF).
            x: (x bitShift: -8)]].
  newI isNegative: x isNegative.
  newI
].

x@(BigInteger traits) canBeASmallInteger
"Answer whether the BigInteger is of a quantity that can fit into a SmallInteger."
[
  x <= SmallInteger maximumValue and: [x >= SmallInteger minimumValue]
].

x@(BigInteger traits) as: i@(SmallInteger traits)
[| n shift |
  x canBeASmallInteger
    ifFalse: [error: 'The integer is too large to be a SmallInteger.'].
  n: 0.
  shift: 0. 
  x isNegative
    ifTrue:
      [x do:
        [| :digit |
          n: n + (digit negated bitShift: shift).
          shift: shift + 8]]
    ifFalse:
      [x do:
        [| :digit |
          n: n + (digit bitShift: shift).
          shift: shift + 8]].
  n
].

i@(BigInteger traits) digitSize
[i size].

i@(BigInteger traits) hash
[| result |
  result: 0.
  i do: [| :digit | result: (result bitXor: digit)].
  result
].

i1@(BigInteger traits) <=> i2@(BigInteger traits)
"Answer the sign of the comparison of the two arguments. It works by comparing
number of digits, then highest-to-lowest."
[| size1 size2 digit1 digit2 |
  size1: i1 digitSize.
  size2: i2 digitSize.
  size1 < size2 ifTrue: [^ -1].
  size2 < size1 ifTrue: [^ 1].
  size1 - 1 downTo: 0
    do: [| :index |
	 (digit2: (i2 at: index)) = (digit1: (i1 at: index))
	   ifFalse: [digit1 < digit2 ifTrue: [^ -1] ifFalse: [^ 1]]].
  0
].

i1@(BigInteger traits) < i2@(BigInteger traits)
[
  i1 isNegative == i2 isNegative
    ifTrue:
      [i1 <=> i2 = (i1 isNegative ifTrue: [1] ifFalse: [-1])]
    ifFalse: [i1 isNegative]
].

i1@(BigInteger traits) = i2@(BigInteger traits)
[
  i1 isNegative == i2 isNegative and: [i1 <=> i2 = 0]
].

i@(BigInteger traits) negated
[| result |
  result: i copy.
  result isNegative: i isNegative not.
  result
].

source@(BigInteger traits) copyInto: target@(BigInteger traits)
[
  0 below: (source digitSize min: target digitSize)
    do: [| :index | target at: index put: (source at: index)].
  target
].

i@(BigInteger traits) grownTo: newSize
[
  i copyInto: (i newSize: newSize)
].

i@(BigInteger traits) grownBy: n
[
  i grownTo: i digitSize + n
].

i@(BigInteger traits) shrunkToFit
"Check for leading zeroes and return a trimmed copy."
[| newI nonZero |
  nonZero: (i indexOfLastSatisfying: [| :digit | digit ~= 0]).
  nonZero isNil
    ifTrue: [^ 0].
  nonZero + 1 = i size
    ifTrue: [newI: i]
    ifFalse: [newI: (i grownTo: nonZero + 1)].
  newI canBeASmallInteger
    ifTrue: [newI as: SmallInteger]
    ifFalse: [newI]
].

i@(Integer traits) shrunkToFit
"Works like BigInteger shrunkToFit."
[i].

i1@(BigInteger traits) logicallyCombineWith: i2@(BigInteger traits) by: logicOp
"Collects the logical (2s-complement) combination, as described by logicOp, 
of a BigInteger with another and returns the collected BigInteger result,
shrunken to the smallest applicable size."
[| bigger smaller newI a b c x y z|
  i1 size < i2 size
    ifTrue: [smaller: i1. bigger: i2]
    ifFalse: [smaller: i2. bigger: i1].
  newI: (bigger newSize: bigger size + 1).
  newI isNegative:
    (logicOp
      applyWith: (smaller isNegative ifTrue: [1] ifFalse: [0])
      with: (bigger isNegative ifTrue: [1] ifFalse: [0])) = 1.
  a: 16r100.
  b: 16r100.
  c: 16r100.
  0 below: bigger size
    do: [| :index |
      x: (index < smaller size ifTrue: [smaller at: index] ifFalse: [0]).
      smaller isNegative
        ifTrue: 
          [a: (a bitShift: -8) + (x bitXor: 16rFF).
            x: (a bitAnd: 16rFF)].
      y: (bigger at: index).
      bigger isNegative
        ifTrue: 
          [b: (b bitShift: -8) + (y bitXor: 16rFF).
            y: (b bitAnd: 16rFF)].
      z: (logicOp applyWith: x with: y).
      newI isNegative
        ifTrue:
          [c: (c bitShift: -8) + (z bitXor: 16rFF).
            z: (c bitAnd: 16rFF)].
      newI at: index put: z].
  x: (smaller isNegative ifTrue: [16rFF] ifFalse: [0]).
  y: (bigger isNegative ifTrue: [16rFF] ifFalse: [0]).
  z: (logicOp applyWith: x with: y).
  newI isNegative
    ifTrue:
      [c: (c bitShift: -8) + (z bitXor: 16rFF).
        z: (c bitAnd: 16rFF)].
  newI at: bigger size put: z.
  newI shrunkToFit
].

i1@(BigInteger traits) bitOr: i2@(BigInteger traits)
[
  i1 logicallyCombineWith: i2 by: [| :x :y | x bitOr: y]
].

i1@(BigInteger traits) bitAnd: i2@(BigInteger traits)
[
  i1 logicallyCombineWith: i2 by: [| :x :y | x bitAnd: y]
].

i1@(BigInteger traits) bitXor: i2@(BigInteger traits)
[
  i1 logicallyCombineWith: i2 by: [| :x :y | x bitXor: y]
].

i1@(BigInteger traits) add: i2@(BigInteger traits)
[| bigger smaller carry sum |
  i1 size < i2 size
    ifTrue: [smaller: i1. bigger: i2]
    ifFalse: [smaller: i2. bigger: i1].
  carry: 0.
  sum: (i1 newSize: bigger size). "Sum gets the same sign as i1."
  0 below: smaller size
    do: [| :index |
      carry: (carry bitShift: -8 "#[BigInteger DigitBitSize negated]")
        + (smaller at: index) + (bigger at: index).
      sum at: index put: (carry bitAnd: 16rFF)].
  smaller size below: bigger size
    do: [| :index |
      carry: (carry bitShift: -8 "#[BigInteger DigitBitSize negated]")
        + (bigger at: index).
      sum at: index put: (carry bitAnd: 16rFF)].
  carry > 16rFF
    ifTrue: [sum: (sum grownBy: 1).
	     sum at: sum size - 1 put: 1].
  sum
].

i1@(BigInteger traits) subtract: i2@(BigInteger traits)
[| bigger smaller diff borrow |
  (i1 <=> i2) = -1
    ifTrue: [smaller: i1. bigger: i2]
    ifFalse: [smaller: i2. bigger: i1].
  borrow: 0.
  diff: bigger newSameSize.
  diff isNegative: (i1 isNegative xor: i1 == smaller).
  0 below: smaller size
    do: [| :index |
      borrow: (borrow bitShift: -8 "#[BigInteger DigitBitSize negated]")
        + (bigger at: index) - (smaller at: index).
      diff at: index put: (borrow bitAnd: 16rFF)].
  smaller size below: bigger size
    do: [| :index |
      borrow: (borrow bitShift: -8 "#[BigInteger DigitBitSize negated]")
        + (bigger at: index).
      diff at: index put: (borrow bitAnd: 16rFF)].
  diff shrunkToFit
].

i1@(BigInteger traits) + i2@(BigInteger traits)
[| result |
  i1 isNegative = i2 isNegative
    ifTrue: [i1 add: i2]
    ifFalse: [i1 subtract: i2]
].

i1@(BigInteger traits) - i2@(BigInteger traits)
[| result |
  i1 isNegative = i2 isNegative
    ifTrue: [i1 subtract: i2]
    ifFalse: [i1 add: i2]
].

i1@(BigInteger traits) * i2@(BigInteger traits)
[| result carry |
  (i1 isZero or: [i2 isZero]) ifTrue: [^ 0].
  result: (i1 newSize: (i1 highBit + i2 highBit + 1) // 8 + 1).
  result isNegative: (i1 isNegative xor: i2 isNegative).
  i1 doWithIndex:
    [| :each1 :index1 |
      carry: 0.
      i2 doWithIndex:
        [| :each2 :index2 |
          carry: (carry bitShift: -8) + (each2 * each1) + (result at: index1 + index2).
          result at: index1 + index2 put: (carry bitAnd: 16rFF)
        ].
      carry > 16rFF
        ifTrue:
          [result at: index1 + i2 size put: (carry bitShift: -8)]
    ].
  result shrunkToFit
].

i@(BigInteger traits) highBit
"Answer the index of the high-order bit of the argument, or zero if it is zero."
[
  (i digitSize - 1) * 8 + i lastDigit highBit
].

i@(BigInteger traits) lowBit
"Answer the index of the low-order bit of the argument, or zero if it is zero."
[| index |
  i isZero ifTrue: [^ 0].
  index: 0.
  [(i at: index) isZero]
    whileTrue: [index: index + 1].
  (i at: index) lowBit + (8 "#[BigInteger DigitBitSize]" * index)
].

i1@(BigInteger traits) add: i2 scaledBy: q at: offset
[| carry |
  carry: 0.
  i2 do:
    [| :digit |
      carry: (carry bitShift: -8) + (i1 at: offset) + (digit * q).
      i1 at: offset put: (carry bitAnd: 16rFF).
      offset: offset + 1
    ].
  [carry > 16rFF]
    whileTrue:
      [carry: (carry bitShift: -8) + (i1 at: offset).
        i1 at: offset put: (carry bitAnd: 16rFF).
        offset: offset + 1].
  i1
].

i1@(BigInteger traits) subtract: i2 at: offset
[| borrow |
  borrow: 0.
  i2 do:
    [| :digit |
      borrow: (borrow bitShift: -8) + (i1 at: offset) - digit.
      i1 at: offset put: (borrow bitAnd: 16rFF).
      offset: offset + 1
    ].
  borrow < 0
    ifTrue:
      [borrow: (borrow bitShift: -8) + (i1 at: offset).
        i1 at: offset put: (borrow bitAnd: 16rFF)].
  i1
].

i@(BigInteger traits) twosComplement
[| carry |
  carry: 16r100.
  i doWithIndex:
    [| :digit :index |
      carry: (carry bitShift: -8) + (digit bitXor: 16rFF).
      i at: index put: (carry bitAnd: 16rFF)
    ].
  carry bitShift: -8
].
  
i1@(BigInteger traits) quoRem: i2@(BigInteger traits)
[| quoRem d shift q lastD quo rem |
  i1 <=> i2
    caseOf:
      {
        -1 -> [^ {0. i1}].
        0 -> [^ {1. 0}]
      }.
  shift: 7 - (i2 highBit bitAnd: 8 - 1).
  quoRem: (i1 newSize: i1 size + 2).
  i1 bitShift: shift into: quoRem.
  d: i2 newSameSize.
  i2 bitShift: shift into: d.
  lastD: d lastDigit.
  d twosComplement.
  quoRem size - 2
    downTo: d size
    do: [| :index |
      q: (quoRem at: index).
      q = lastD
        ifTrue: 
          [q: 16rFF]
        ifFalse: 
          [q: ((q bitShift: 8) + (quoRem at: index - 1) quo: lastD)].
      quoRem add: d scaledBy: q at: index - d size.
      [(quoRem at: index) = q]
        whileFalse:
          [quoRem subtract: d at: index - d size.
            q: q - 1]].      
  quo: (i1 newSize: quoRem size - d size).
  quo isNegative: (i1 isNegative xor: i2 isNegative).
  quoRem bitShift: d size * -8 into: quo.
  rem: i2 newSameSize.
  quoRem bitShift: shift negated into: rem.
  { quo shrunkToFit. rem shrunkToFit }
].
  
i1@(BigInteger traits) / i2@(BigInteger traits)
[| quoRem |
  quoRem: (i1 quoRem: i2).
  quoRem second isZero "No remainder."
    ifTrue: [quoRem first]
    ifFalse: [resend] "Make a fraction."
].

i1@(BigInteger traits) quo: i2@(BigInteger traits)
[
  (i1 quoRem: i2) first
].

_@(SmallInteger traits) quo: _@(BigInteger traits)
[
  0
].

i1@(BigInteger traits) quo: i2@(SmallInteger traits)
[
  i2 isZero ifTrue: [^ i1 divideByZero].
  i1 quo: (i2 as: BigInteger)
].

i1@(BigInteger traits) rem: i2@(BigInteger traits)
[
  (i1 quoRem: i2) second
].

r@(SmallInteger traits) rem: _@(BigInteger traits)
[
  r
].

i1@(BigInteger traits) rem: i2@(SmallInteger traits)
[
  i2 isZero ifTrue: [^ i1 divideByZero].
  i1 rem: (i2 as: BigInteger)
].

i@(BigInteger traits) bitShift: n into: result
[| source offset carry limit |
  source: n // 8.
  offset: n \\ 8.
  (n isNegative and: [offset isPositive] and: [-1 - source < i size])
    ifTrue:
      [carry: ((i at: -1 - source) bitShift: offset)]
    ifFalse:
      [carry: 0].
  limit: (i size min: result size - source).
  (source negated max: 0) below: limit 
    do: [| :index |
      carry: (carry bitShift: -8) + ((i at: index) bitShift: offset).
      result at: index + source put: (carry bitAnd: 16rFF)].
  (carry > 16rFF and: [limit + source < result size])
    ifTrue: [result at: limit + source put: (carry bitShift: -8)].
  result
].

i@(BigInteger traits) bitShift: n@(SmallInteger traits)
[| result |
  (i isZero or: [n isZero]) ifTrue: [^ 0].
  result: (i newSize: (i highBit + n // 8 max: 0) + 1).
  i bitShift: n into: result.
  (i isNegative and: [i lowBit < n negated])
    ifTrue: [result - 1]
    ifFalse: [result shrunkToFit]
].

x@(Integer traits) raisedTo: y mod: n
"Answer the modular exponential. Originally by Jesse Welton (?)."
[| s t u |
  s: 1.
  t: x.
  u: y.
  [u isZero]
    whileFalse:
      [u isOdd
	 ifTrue:
	   [s: s * t.
	    s >= n ifTrue: [s: s \\ n]].
       t: t * t.
       t >= n ifTrue: [t: t \\ n].
       u: (u bitShift: -1)].
  s
].