DIRECTORY
Basics USING [CompareInt, Comparison, LongNumber],
BigCardinals USING [BigAdd, BigCARD, BigCompare, BigDivMod, BigFail, BigFromCard, BigGCD, BigMultiply, BigOdd, BigSubtract, BigToCard, TimesTwoToTheNth, Zero],
Real USING [Fix, FScale, Round],
RealFns USING [ArcTan, Cos, Exp, Ln, Power, Sin, SqRt, Tan],
Scheme USING [Any, ArithOp, Bignum, Car, Cdr, Complain, Complex, Cons, DefinePrimitive, Environment, false, Fixnum, Flonum, Number, NumberKind, NumberRep, Primitive, ProperList, Ratnum, RegisterInit, Symbol, true, undefined];

SchemeArithmeticImpl: CEDAR PROGRAM
IMPORTS Basics, BigCardinals, Real, RealFns, Scheme
EXPORTS Scheme
~ BEGIN OPEN Scheme;

PrimitiveProc: TYPE ~ PROC [self: Primitive, a, b, c: Any, rest: ProperList] RETURNS [result: Any ¬ NIL];

SmallValue: TYPE ~ [-100..1000];

smallFixnumTable: REF ARRAY SmallValue OF Fixnum ~ InitSmallFixnumTable[];
InitSmallFixnumTable: PROC RETURNS [a: REF ARRAY SmallValue OF Fixnum] ~ {
a ¬ NEW[ARRAY SmallValue OF Fixnum];
FOR i: INT IN SmallValue DO
a[i] ¬ NEW[INT ¬ i];
ENDLOOP;
};

MakeFixnum: PUBLIC PROC [int: INT] RETURNS [Fixnum] ~ {
IF int IN SmallValue
THEN RETURN [smallFixnumTable[int]]
ELSE RETURN [NEW[INT ¬ int]]
};

Negative: PUBLIC PROC [a: Any] RETURNS [BOOL] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [a­<0];
a: Flonum => RETURN [a.real<0.0];
a: Bignum => RETURN [a.neg];
a: Ratnum => RETURN [Negative[a.numerator]];
ENDCASE => Complain[a, "not a real number"];
};

TheReal: PROC [a: Any] RETURNS [Any] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [a];
a: Flonum => RETURN [a];
a: Bignum => RETURN [a];
a: Ratnum => RETURN [a];
ENDCASE => Complain[a, "not a real number"];
};

ComplexPrim: PrimitiveProc ~ {
SELECT self.data FROM
$rectangular => 
RETURN [MakeRectangular[a, b]];
$polar =>
RETURN [MakePolar[a, b]];
$realPart => {
WITH a SELECT FROM
c: Complex => {RETURN [c.x]};
ENDCASE => {RETURN [TheReal[a]]};
};
$imagPart => {
WITH a SELECT FROM
c: Complex => {RETURN [c.y]};
ENDCASE => {RETURN [Zero[Exact[a]]]};
};
ENDCASE => ERROR;
};

MakeNumber: PROC [any: Any] RETURNS [Number] ~ {
WITH any SELECT FROM
a: Fixnum => {
card: CARD ~ ABS[a­]; -- will ABS overflow for INT.FIRST? not for PrincOps.
bigCARD: BigCardinals.BigCARD ~ BigCardinals.BigFromCard[card];
RETURN [NEW[NumberRep.bignum ¬ [TRUE, bignum[a­<0, bigCARD]]]]
};
num: Number => RETURN [num];
ENDCASE => Complain[any, "not a number"];
};

inexactZero: Flonum ~ NEW[NumberRep.flonum ¬ [FALSE, flonum[0.0]]];
exactZero: Fixnum ~ MakeFixnum[0];

Zero: PROC [exact: BOOL] RETURNS [Any] ~ {
RETURN [IF exact THEN exactZero ELSE inexactZero]
};

MakeRectangular: PUBLIC PROC [realPart, imagPart: Any] RETURNS [Any] ~ {
exact: BOOL ~ Exact[TheReal[realPart]] AND Exact[TheReal[imagPart]];
IF NumericallyEqual[imagPart, exactZero] THEN RETURN [ConvertExactness[realPart, exact]];
RETURN [NEW[NumberRep.complex ¬
[exact, complex[ConvertExactness[realPart, exact], ConvertExactness[imagPart, exact]]]
]]
};

MakePolar: PUBLIC PROC [magnitude, angle: Any] RETURNS [Any] ~ {
exact: BOOL ~ Exact[TheReal[magnitude]] AND Exact[TheReal[angle]];
IF NumericallyEqual[angle, exactZero]
THEN RETURN [ConvertExactness[magnitude, exact]]
ELSE {
f: REAL ~ TheREAL[angle];
cos: REAL ~ RealFns.Cos[f];
sin: REAL ~ RealFns.Sin[f];
cis: Complex ~
NEW[NumberRep.complex ¬[FALSE, complex[
NEW[NumberRep.flonum ¬ [FALSE, flonum[cos]]],
NEW[NumberRep.flonum ¬ [FALSE, flonum[sin]]]]]];
RETURN [Arith[mult, magnitude, cis]]
};
};

TheINT: PUBLIC PROC [any: Any] RETURNS [INT] ~ {
WITH TheInteger[any] SELECT FROM
k: Fixnum => { RETURN [k­] };
num: Bignum => {
c: CARD ¬ CARD.LAST;
c ¬ BigCardinals.BigToCard[num.magnitude ! BigCardinals.BigFail => CONTINUE];
IF num.neg 
THEN { IF c <= CARD[INT.LAST]+1 THEN RETURN [-c] }
ELSE { IF c <= CARD[INT.LAST] THEN RETURN [c] };
};
ENDCASE => ERROR;
Complain[any, "integer out of bounds"];
};

TheCARD: PUBLIC PROC [any: Any] RETURNS [CARD] ~ {
WITH TheInteger[any] SELECT FROM
k: Fixnum => { IF 0 <= k­ THEN RETURN [k­] };
num: Bignum => {
c: CARD ¬ CARD.LAST;
ok: BOOL ¬ TRUE;
c ¬ BigCardinals.BigToCard[num.magnitude ! BigCardinals.BigFail => {ok¬FALSE; CONTINUE}];
IF ok AND NOT num.neg THEN { RETURN [c] };
};
ENDCASE => ERROR;
Complain[any, "integer out of bounds"];
};

KCheck: PUBLIC PROC [any: Any, max: INT ¬ INT.LAST] RETURNS [INT] ~ {
WITH TheInteger[any] SELECT FROM
k: Fixnum => { IF 0 <= k­ AND k­ <= max THEN RETURN [k­] };
num: Bignum => {
c: CARD ¬ CARD.LAST;
IF NOT num.exact THEN Complain[any, "not an exact integer"];
c ¬ BigCardinals.BigToCard[num.magnitude ! BigCardinals.BigFail => CONTINUE];
IF c <= CARD[max] AND NOT num.neg THEN RETURN [c];
};
ENDCASE => ERROR;
Complain[any, "integer out of bounds"];
};

TheComplex: PUBLIC PROC [a: Any] RETURNS [Complex] ~ {
WITH a SELECT FROM
a: Complex => RETURN [a];
n: Fixnum => NULL;
n: Number => NULL;
ENDCASE => Complain[a, "not a number"];
RETURN [NEW[NumberRep.complex ¬ [Exact[a], complex[x: a, y: MakeFixnum[0]]]]]
};

Frac: PROC [num: BigCardinals.BigCARD] RETURNS [REAL] ~ {
v: REAL ¬ 0.0;
IF num # BigCardinals.Zero THEN {
sig: INT ¬ -INT[num.size]*BITS[CARD16];
FOR i: NAT IN [0..num.size) DO
v ¬ v + Real.FScale[num.contents[i], sig];
sig ¬ sig + BITS[CARD16];
ENDLOOP;
};
RETURN [v]
};

Exponent: PROC [num: BigCardinals.BigCARD] RETURNS [INT] ~ {
RETURN [IF num = BigCardinals.Zero THEN 0 ELSE INT[num.size]*BITS[CARD16]]
};

TheREAL: PUBLIC PROC [a: Any] RETURNS [REAL] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [REAL[a­]];
a: Flonum => RETURN [a.real];
a: Bignum => {
mag: REAL ~ Real.FScale[Frac[a.magnitude], Exponent[a.magnitude]];
v: REAL ~ IF a.neg THEN -mag ELSE mag;
RETURN [v]
};
a: Ratnum => {
n: Bignum ~ NARROW[a.numerator];
d: Bignum ~ NARROW[a.denominator];
mag: REAL ~ Real.FScale[Frac[n.magnitude]/Frac[d.magnitude], Exponent[n.magnitude]-Exponent[d.magnitude]];
v: REAL ~ IF n.neg THEN -mag ELSE mag;
RETURN [v]
};
ENDCASE => Complain[a, "domain error"];
};

TheFlonum: PUBLIC PROC [a: Any] RETURNS [Flonum] ~ {
WITH a SELECT FROM
a: Flonum => RETURN [a];
ENDCASE => RETURN [NEW[NumberRep.flonum ¬ [FALSE, flonum[TheREAL[a]]]]];
};

Exact: PUBLIC PROC [a: Any] RETURNS [BOOL] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [TRUE];
a: Number => RETURN [a.exact];
ENDCASE => Complain[a, "not a number"];
};

Odd: PROC [a: Any] RETURNS [BOOL] ~ {
WITH TheInteger[a] SELECT FROM
a: Fixnum => RETURN [OddINT[a­]];
b: Bignum => RETURN [BigCardinals.BigOdd[b.magnitude]];
ENDCASE => ERROR;
};

OddINT: PROC [int: INT] RETURNS [BOOL] ~ {
lc: Basics.LongNumber ~ [li[int]];
RETURN [VAL[lc.lo MOD 2]]
};

largestFlonumFraction: REAL ¬ LargestFlonumFraction[];
LargestFlonumFraction: PROC RETURNS [REAL] ~ INLINE {
a: REAL ¬ 0.5;
FOR i: NAT IN [0..1000) DO
b: REAL ~ a+a+0.5;
IF b = REAL[Real.Fix[b]] THEN RETURN [a];
a ¬ b;
ENDLOOP;
ERROR; -- this doesn't act like floating point!
};

IsNaN: PROC [real: REAL] RETURNS [BOOL] ~ INLINE {
SingleReal: TYPE = MACHINE DEPENDENT RECORD [
sign: BOOL, exp: CARDINAL [0..377B], m: CARDINAL [0..37777777B] ];
rep: SingleReal ~ LOOPHOLE[real];
RETURN [rep.exp = 255]
};

TheInteger: PUBLIC PROC [a: Any] RETURNS [Any] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [a];
a: Bignum => RETURN [a];
f: Flonum => {
bignum: Bignum ¬ NIL;
IF ABS[f.real] > largestFlonumFraction
THEN {
s: REAL ¬ f.real;
e: NAT ¬ 0;
UNTIL ABS[s] < LAST[INT] DO
s ¬ s*0.5;
e ¬ e + 1;
ENDLOOP;
bignum ¬ NARROW[MakeNumber[MakeFixnum[Real.Fix[s]]]];
IF FALSE -- TRUE if BigCardinals.TimesTwoToTheNth is buggy
THEN {
FOR i: NAT IN [0..e) DO
bignum.magnitude ¬ BigCardinals.BigAdd[bignum.magnitude, bignum.magnitude];
ENDLOOP;
}
ELSE bignum.magnitude ¬ BigCardinals.TimesTwoToTheNth[bignum.magnitude, e];
bignum.exact ¬ f.exact;
RETURN [bignum]
}
ELSE IF f.real = REAL[Real.Fix[f.real]] THEN {
bignum ¬ NARROW[MakeNumber[MakeFixnum[Real.Fix[f.real]]]];
};
IF bignum # NIL THEN { bignum.exact ¬ f.exact; RETURN [bignum] };
};
ENDCASE => NULL;
Complain[a, "not an integer"];
};

IsInteger: PUBLIC PROC [a: Any] RETURNS [BOOL] ~ {
WITH a SELECT FROM
a: Fixnum => RETURN [TRUE];
a: Number => {
WITH a SELECT FROM
bignum: Bignum => RETURN [TRUE];
flonum: Flonum => {
IF ABS[flonum.real] > largestFlonumFraction THEN RETURN [TRUE];
IF flonum.real = REAL[Real.Fix[flonum.real]] THEN RETURN [TRUE];
};
ENDCASE => NULL;
};
ENDCASE => NULL;
RETURN [FALSE]
};

NumTypePredPrim: PrimitiveProc ~ {
t: Any ~ self.data;
WITH a SELECT FROM
a: Fixnum => RETURN [SELECT t FROM $number, $complex, $real, $rational, $integer, $exact => true, $inexact => false, $odd => (IF OddINT[a­] THEN true ELSE false),  $even => (IF OddINT[a­] THEN false ELSE true) ENDCASE => ERROR];
a: Number => {
SELECT t FROM
$exact => RETURN [IF a.exact THEN true ELSE false];
$inexact => RETURN [IF a.exact THEN false ELSE true];
$number => RETURN [true];
$complex => IF a.tag <= complex THEN RETURN [true];
$real => IF a.tag <= ratnum THEN RETURN [true];
$rational => IF a.tag = ratnum OR IsInteger[a] THEN RETURN [true];
$integer => IF IsInteger[a] THEN RETURN [true];
$odd, $even => {
is: Symbol ¬ IF Odd[a] THEN $odd ELSE $even;
RETURN [IF is=t THEN true ELSE false]
};
ENDCASE => ERROR;
};
ENDCASE => { SELECT t FROM $exact, $inexact, $odd, $even => Complain[a, "domain error"] ENDCASE};
RETURN [false]
};

Raise: PROC [a: Number, b: Number] RETURNS [Number] ~ {
WITH a SELECT FROM
flonum: Flonum => {
IF IsInteger[flonum]
THEN RETURN [MakeNumber[TheInteger[flonum]]]
ELSE {
f: REAL ¬ flonum.real*2.0;
t: REAL ¬ 2.0;
bigt: BigCardinals.BigCARD ¬ bignumTwo.magnitude;
UNTIL ABS[f] > largestFlonumFraction OR t > 1.0e+15 DO
f ¬ f * t;
t ¬ t * t;
bigt ¬ BigCardinals.BigMultiply[bigt, bigt];
ENDLOOP;
UNTIL ABS[f] > largestFlonumFraction DO
f ¬ f * 2.0;
bigt ¬ BigCardinals.BigAdd[bigt, bigt];
ENDLOOP;
RETURN [NARROW[MakeRatnum[num: NARROW[MakeNumber[TheInteger[NEW[NumberRep.flonum ¬ [TRUE, flonum[f]]]]]], denom: NARROW[MakeBignum[neg: FALSE, mag: bigt, exact: TRUE, reduce: FALSE]], exact: flonum.exact]]]
};
};
bignum: Bignum => {
RETURN [NEW[NumberRep.ratnum ¬ [a.exact, ratnum[bignum, bignumOne]]]]
};
ENDCASE => NULL;
IF b.tag = complex AND a.tag < complex THEN {
RETURN [NEW[NumberRep.complex ¬ [a.exact, complex[a, MakeFixnum[0]]]]]
};
Complain[a, "unimplemented coercion"]
};

refForComparison: REF ARRAY Basics.Comparison OF REF Basics.Comparison ¬ NEW[ARRAY Basics.Comparison OF REF Basics.Comparison ¬ [less: NEW[Basics.Comparison ¬ less], equal: NEW[Basics.Comparison ¬ equal], greater: NEW[Basics.Comparison ¬ greater]]];

FlonumArith: PROC [op: ArithOp, a: REAL, b: REAL] RETURNS [Any] ~ {
CompareREAL: PROC [a, b: REAL] RETURNS [c: Basics.Comparison] ~ INLINE { 
c ¬ SELECT TRUE FROM
a=b => equal,
a>b => greater,
ENDCASE => less;
};
realResult: REAL ¬ 0.0;
SELECT op FROM
plus => realResult ¬ (a+b);
minus => realResult ¬ (a-b);
mult => realResult ¬ (a*b);
divide => realResult ¬ (a/b);
equality => RETURN [IF a = b THEN true ELSE false];
compare => RETURN [refForComparison[CompareREAL[a, b]]];
ENDCASE => ERROR;
IF IsNaN[realResult] THEN RETURN [NIL];
RETURN [NEW[NumberRep.flonum ¬ [FALSE, flonum[realResult]]]]
};

bigINT: BigCardinals.BigCARD ~ BigCardinals.BigFromCard[LAST[INT]];
MakeBignum: PROC [neg: BOOL, mag: BigCardinals.BigCARD, exact: BOOL, reduce: BOOL ¬ TRUE] RETURNS [Any] ~ {
IF reduce AND exact AND BigCardinals.BigCompare[mag, bigINT] # greater THEN {
i: INT ¬ BigCardinals.BigToCard[mag];
IF neg THEN i ¬ -i;
RETURN [MakeFixnum[i]]
};
RETURN [NEW[NumberRep.bignum ¬ [exact, bignum[neg, mag]]]]
};

BignumArith: PROC [op: ArithOp, a: Bignum, b: Bignum, reduce: BOOL ¬ TRUE] RETURNS [Any] ~ {
aMag: BigCardinals.BigCARD ¬ a.magnitude;
aNeg: BOOL ¬ a.neg;
bMag: BigCardinals.BigCARD ¬ b.magnitude;
bNeg: BOOL ¬ b.neg;
DO
SELECT op FROM
plus => {
IF aNeg # bNeg THEN { bNeg ¬ NOT bNeg; op ¬ minus; LOOP };
aMag ¬ BigCardinals.BigAdd[aMag, bMag];
};
minus => {
IF aNeg # bNeg THEN { bNeg ¬ NOT bNeg; op ¬ plus; LOOP };
SELECT BigCardinals.BigCompare[aMag, bMag] FROM
greater => { aMag ¬ BigCardinals.BigSubtract[large: aMag, small: bMag] };
equal => { aMag ¬ BigCardinals.Zero; aNeg ¬ FALSE };
less => { aMag ¬ BigCardinals.BigSubtract[large: bMag, small: aMag]; aNeg ¬ NOT aNeg };
ENDCASE => ERROR;
};
mult => {
aMag ¬ BigCardinals.BigMultiply[aMag, bMag];
aNeg ¬ aNeg # bNeg AND aMag#BigCardinals.Zero;
};
divide => { RETURN [MakeRatnum[a, b, a.exact AND b.exact]] };
equality, compare => {
sigA: INT ~ IF aMag=BigCardinals.Zero THEN 0 ELSE IF aNeg THEN -1 ELSE +1;
sigB: INT ~ IF bMag=BigCardinals.Zero THEN 0 ELSE IF bNeg THEN -1 ELSE +1;
c: Basics.Comparison ¬ Basics.CompareInt[sigA, sigB];
IF c = equal THEN {
c ¬ IF aNeg THEN BigCardinals.BigCompare[bMag, aMag] ELSE BigCardinals.BigCompare[aMag, bMag];
};
IF op = equality THEN RETURN [IF c = equal THEN true ELSE false];
RETURN [refForComparison[c]];
};
quotient => {
aMag ¬ BigCardinals.BigDivMod[aMag, bMag ! BigCardinals.BigFail => IF subclass = $DivideByZero THEN Complain[a, "divided by zero"]].quo;
aNeg ¬ aNeg # bNeg AND aMag#BigCardinals.Zero;
};
remainder => {
aMag ¬ BigCardinals.BigDivMod[aMag, bMag ! BigCardinals.BigFail => IF subclass = $DivideByZero THEN Complain[a, "divided by zero"]].rem;
};
ENDCASE => ERROR;
EXIT;
ENDLOOP;
RETURN [MakeBignum[neg: aNeg, mag: aMag, exact: a.exact AND b.exact, reduce: reduce]]
};

bignumOne: Bignum ~ NEW[NumberRep.bignum ¬ [TRUE, bignum[FALSE, BigCardinals.BigFromCard[1]]]];
bignumTwo: Bignum ~ NEW[NumberRep.bignum ¬ [TRUE, bignum[FALSE, BigCardinals.BigFromCard[2]]]];
half: Ratnum ~ NARROW[MakeRatnum[bignumOne, bignumTwo, TRUE]];
MakeRatnum: PROC [num, denom: Bignum, exact: BOOL] RETURNS [Any] ~ {
gcd: BigCardinals.BigCARD ~ BigCardinals.BigGCD[num.magnitude, denom.magnitude];
IF num.exact AND denom.exact AND NOT denom.neg AND
BigCardinals.BigCompare[gcd, bignumOne.magnitude] = equal AND
BigCardinals.BigCompare[denom.magnitude, bignumOne.magnitude] # equal
THEN NULL
ELSE {
numMag: BigCardinals.BigCARD ~ BigCardinals.BigDivMod[num.magnitude, gcd].quo;
denomMag: BigCardinals.BigCARD ~ BigCardinals.BigDivMod[denom.magnitude, gcd].quo;
numNeg: BOOL ~ num.neg # denom.neg AND numMag # BigCardinals.Zero;
IF BigCardinals.BigCompare[denomMag, bignumOne.magnitude] = equal THEN RETURN [MakeBignum[numNeg, numMag, exact]];
num ¬ NEW[NumberRep.bignum ¬ [TRUE, bignum[numNeg, numMag]]];
denom ¬ NEW[NumberRep.bignum ¬ [TRUE, bignum[FALSE, denomMag]]];
};
RETURN [NEW[NumberRep.ratnum ¬ [exact, ratnum[num, denom]]]]
};

RationalArith: PROC [op: ArithOp, a: Ratnum, b: Ratnum] RETURNS [Any] ~ {
aNum: Bignum ~ NARROW[a.numerator];
aDenom: Bignum ~ NARROW[a.denominator];
bNum: Bignum ~ NARROW[b.numerator];
bDenom: Bignum ~ NARROW[b.denominator];
num: Bignum ¬ NIL;
denom: Bignum ¬ NIL;
SELECT op FROM
plus => {
aNbD: Bignum ~ NARROW[BignumArith[mult, aNum, bDenom, FALSE]];
aDbN: Bignum ~ NARROW[BignumArith[mult, aDenom, bNum, FALSE]];
num ¬ NARROW[BignumArith[plus, aNbD, aDbN, FALSE]];
denom ¬ NARROW[BignumArith[mult, aDenom, bDenom, FALSE]];
};
minus => {
aNbD: Bignum ~ NARROW[BignumArith[mult, aNum, bDenom, FALSE]];
aDbN: Bignum ~ NARROW[BignumArith[mult, aDenom, bNum, FALSE]];
num ¬ NARROW[BignumArith[minus, aNbD, aDbN, FALSE]];
denom ¬ NARROW[BignumArith[mult, aDenom, bDenom, FALSE]];
};
mult => {
num ¬ NARROW[BignumArith[mult, aNum, bNum, FALSE]];
denom ¬ NARROW[BignumArith[mult, aDenom, bDenom, FALSE]];
};
divide => {
num ¬ NARROW[BignumArith[mult, aNum, bDenom, FALSE]];
denom ¬ NARROW[BignumArith[mult, aDenom, bNum, FALSE]];
};
equality => {
RETURN [IF BignumArith[equality, aNum, bNum] = true AND BignumArith[equality, aDenom, bDenom] = true THEN true ELSE false]
};
compare => {
sigA: INT ~ IF aNum.magnitude=BigCardinals.Zero THEN 0 ELSE IF aNum.neg THEN -1 ELSE +1;
sigB: INT ~ IF bNum.magnitude=BigCardinals.Zero THEN 0 ELSE IF bNum.neg THEN -1 ELSE +1;
c: Basics.Comparison ¬ Basics.CompareInt[sigA, sigB];
IF c = equal THEN {
left: Bignum ¬ NARROW[BignumArith[mult, aNum, bDenom, FALSE]];
right: Bignum ¬ NARROW[BignumArith[mult, bNum, aDenom, FALSE]];
RETURN [BignumArith[compare, left, right]]
};
RETURN [refForComparison[c]];
};
ENDCASE => ERROR;
RETURN [MakeRatnum[num, denom, a.exact AND b.exact]]
};

ComplexArith: PROC [op: ArithOp, a: Complex, b: Complex] RETURNS [Any] ~ {
realPart: Any ¬ NIL;
imagPart: Any ¬ NIL;
exact: BOOL ~ a.exact AND b.exact;
SELECT op FROM
plus, minus => {realPart ¬ Arith[op, a.x, b.x]; imagPart ¬ Arith[op, a.y, b.y]};
mult => {
realPart ¬ Arith[minus, Arith[mult, a.x, b.x], Arith[mult, a.y, b.y]];
imagPart ¬ Arith[plus, Arith[mult, a.x, b.y], Arith[mult, a.y, b.x]];
};
divide => {
d: Any ~ Arith[plus, Arith[mult, b.x, b.x], Arith[mult, b.y, b.y]];
xd: Any ~ Arith[plus, Arith[mult, a.x, b.x], Arith[mult, a.y, b.y]];
yd: Any ~ Arith[minus, Arith[mult, a.y, b.x], Arith[mult, a.x, b.y]];
realPart ¬ Arith[divide, xd, d];
imagPart ¬ Arith[divide, yd, d];
};
equality => {
RETURN [IF Arith[equality, a.x, b.x] = true AND Arith[equality, a.y, b.y] = true THEN true ELSE false];
};
compare => Complain[Cons[a, Cons[b, NIL]], "comparison not allowed for non-reals"];
ENDCASE => ERROR;
IF Arith[equality, imagPart, MakeFixnum[0]] = true AND exact = Exact[realPart] THEN RETURN [ConvertExactness[realPart, exact]];
RETURN [NEW[NumberRep.complex ¬ [exact, complex[ConvertExactness[realPart, exact], ConvertExactness[imagPart, exact]]]]]
};


Arith: PUBLIC PROC [op: ArithOp, a: Any, b: Any] RETURNS [Any] ~ {
integerOp: BOOL ~ SELECT op FROM quotient, remainder => TRUE ENDCASE => FALSE;
WITH a SELECT FROM
aa: Fixnum => {
WITH b SELECT FROM
bb: Fixnum => {
a: INT ~ aa­;
b: INT ~ bb­;
SELECT op FROM
plus => {
IF a >= 0
THEN {IF b <= 0 OR a <= INT.LAST-b THEN RETURN [MakeFixnum[a+b]]}
ELSE {IF b >= 0 OR a >= INT.FIRST-b THEN RETURN [MakeFixnum[a+b]]};
};
minus => {
IF a >= 0
THEN {IF b >= 0 OR a <= INT.LAST+b THEN RETURN [MakeFixnum[a-b]]}
ELSE {IF b <= 0 OR a >= INT.FIRST+b THEN RETURN [MakeFixnum[a-b]]};
};
mult => { IF MAX[ABS[a],ABS[b]] <= 32767 THEN RETURN [MakeFixnum[a*b]] };
divide => {
IF b = 0 THEN Complain[aa, "divided by zero"];
IF a MOD b = 0 THEN RETURN [MakeFixnum[a/b]];
};
quotient => {
IF a >= 0 AND b > 0 THEN RETURN [MakeFixnum[a/b]];
};
remainder => {
IF a >= 0 AND b > 0 THEN RETURN [MakeFixnum[a MOD b]];
};
equality => { RETURN [IF a=b THEN true ELSE false] };
compare => { RETURN [refForComparison[Basics.CompareInt[a, b]]] };
ENDCASE => ERROR;
};
ENDCASE => NULL;
};
ENDCASE => NULL;
-- handle complex and flonum arithmetic -- {
aComplex, aExact, bComplex, bExact: BOOL ¬ FALSE;
WITH a SELECT FROM
n: Fixnum => { aExact ¬ TRUE };
n: Number => { aExact ¬ n.exact; aComplex ¬ (n.tag = complex) };
ENDCASE => NULL;
WITH b SELECT FROM
n: Fixnum => { bExact ¬ TRUE };
n: Number => { bExact ¬ n.exact; bComplex ¬ (n.tag = complex) };
ENDCASE => NULL;
IF NOT (integerOp OR (aExact AND bExact)) THEN {
IF aComplex OR bComplex
THEN {RETURN [ComplexArith[op, TheComplex[a], TheComplex[b]]]}
ELSE {
result: Any ~ FlonumArith[op, TheREAL[a], TheREAL[b]];
IF result # NIL THEN RETURN[result];
};
};
};
-- coerce to compatible types before operating -- {
x: Number ¬ MakeNumber[IF integerOp THEN TheInteger[a] ELSE a];
y: Number ¬ MakeNumber[IF integerOp THEN TheInteger[b] ELSE b];
IF x.tag < bignum THEN x ¬ Raise[x, bignumOne]; -- don't do floating-point arithmetic if the arguments are exact or if there was a floating-point exception
UNTIL x.tag = y.tag DO
WHILE x.tag < y.tag DO x ¬ Raise[x, y] ENDLOOP;
WHILE x.tag > y.tag DO y ¬ Raise[y, x] ENDLOOP;
ENDLOOP;
SELECT x.tag FROM
bignum => RETURN [BignumArith[op, NARROW[x], NARROW[y]]];
ratnum => RETURN [RationalArith[op, NARROW[x], NARROW[y]]];
complex => RETURN [ComplexArith[op, NARROW[x], NARROW[y]]];
general => ERROR; -- not yet implemented
ENDCASE => ERROR;
};
};

ArithPrim: PrimitiveProc ~ {
op: ArithOp ~ NARROW[self.data, REF ArithOp]­;
IF op IN [plus..divide] THEN {
IF b = undefined 
THEN {
identity: Any ~ MakeFixnum[IF op IN [plus..minus] THEN 0 ELSE 1];
b ¬ IF a = undefined THEN identity ELSE a;
a ¬ identity;
}
ELSE {
com: ArithOp ¬ SELECT op FROM minus => plus, divide => mult ENDCASE => op;
WHILE rest # NIL DO
b ¬ Arith[com, b, rest.car];
rest ¬ NARROW[rest.cdr]
ENDLOOP;
}
};
result ¬ Arith[op, a, b];
};

MakeReal: PUBLIC PROC [negative: BOOL, numerator, denominator: BigCardinals.BigCARD, exponent: INT, radix: INT, exact: BOOL] RETURNS [Any] ~ {
num: Any ¬ MakeBignum[negative, numerator, exact];
denom: Any ¬ MakeBignum[FALSE, denominator, exact];
core: Any ¬ Arith[divide, num, denom];

IF exponent = 0 THEN 
RETURN [core]
ELSE {
zero: Fixnum ¬ MakeFixnum[0];
one: Fixnum ¬ MakeFixnum[1];
two: Fixnum ¬ MakeFixnum[2];
Expt: PROC [base, exponent: Any] RETURNS [Any] ~ {
IF NumericallyEqual[exponent, zero] THEN 
RETURN [one]
ELSE IF Odd[exponent] THEN 
RETURN [Arith[mult, base, Expt[base, Arith[minus, exponent, one]]]]
ELSE {
part: Any ¬ Expt[base, Arith[quotient, exponent, two]];
RETURN [Arith[mult, part, part]]
};
};
expPart: Any ¬ Expt[MakeFixnum[radix], MakeFixnum[ABS[exponent]]];

RETURN [Arith[IF exponent < 0 THEN divide ELSE mult, core, expPart]]
};
};

ConvertExactness: PUBLIC PROC [a: Any, exact: BOOL] RETURNS [Any] ~ {
IF Exact[a] = exact
THEN RETURN [a]
ELSE {
WITH a SELECT FROM
a: Fixnum => RETURN [MakeBignum[neg: a­ < 0, mag: BigCardinals.BigFromCard[ABS[a­]], exact: exact]];
b: Bignum => RETURN [MakeBignum[neg: b.neg, mag: b.magnitude, exact: exact]];
f: Flonum => {
IF exact AND IsInteger[f]
THEN RETURN [ConvertExactness[TheInteger[f], exact]]
ELSE RETURN [NEW[NumberRep.flonum ¬ [exact, flonum[f.real]]]];
};
q: Ratnum => RETURN [NEW[NumberRep.ratnum ¬ [exact, ratnum[q.numerator, q.denominator]]]];
z: Complex => RETURN [NEW[NumberRep.complex ¬ [exact, complex[ConvertExactness[z.x, exact], ConvertExactness[z.y, exact]]]]];
ENDCASE => ERROR;
};
};

NumericallyEqual: PROC [a, b: Any] RETURNS [BOOL] ~ INLINE {
RETURN [Arith[equality, a, b]#false];
};

RealFnsPrim: PrimitiveProc ~ {
f: REAL ~ TheREAL[a];
imag: BOOL ¬ FALSE;
realResult: REAL ¬ 0.0;
flo: Flonum ¬ NIL;
IF IsNaN[f] THEN realResult ¬ f ELSE SELECT self.data FROM
$sqrt => {realResult ¬ RealFns.SqRt[ABS[f]]; imag ¬ (f < 0)};
$exp => {realResult ¬ RealFns.Exp[f]};
$expt => {
e: REAL ~ TheREAL[b];
realResult ¬ IF IsNaN[e] THEN e ELSE RealFns.Power[f, e];
};
$log => {realResult ¬ RealFns.Ln[f]};
$sin => {realResult ¬ RealFns.Sin[f]};
$cos => {realResult ¬ RealFns.Cos[f]};
$tan => {realResult ¬ RealFns.Tan[f]};
$atan => {
IF b = undefined
THEN realResult ¬ RealFns.ArcTan[f, 1.0]
ELSE {
e: REAL ~ TheREAL[b];
realResult ¬ IF IsNaN[e] THEN e ELSE RealFns.ArcTan[f, e];
};
};
ENDCASE => ERROR;
IF IsNaN[realResult] THEN Complain[Cons[a, IF b = undefined THEN NIL ELSE Cons[b, NIL]], " floating-point exception"];
flo ¬ NEW[NumberRep.flonum ¬ [FALSE, flonum[realResult]]];
IF imag THEN RETURN [NEW[NumberRep.complex ¬ [FALSE, complex[MakeFixnum[0], flo]]]] ELSE RETURN [flo]
};

NumFnsPrim: PrimitiveProc ~ {
SELECT self.data FROM
$numerator => {
IF IsInteger[a] THEN RETURN [a];
WITH a SELECT FROM
r: Ratnum => RETURN [r.numerator]
ENDCASE => Complain[a, "is not rational"];
};
$denominator => {
IF IsInteger[a] THEN RETURN [MakeFixnum[1]];
WITH a SELECT FROM
r: Ratnum => RETURN [r.denominator]
ENDCASE => Complain[a, "is not rational"];
};
$gcd => {
gcd: BigCardinals.BigCARD ¬ BigCardinals.Zero;
exact: BOOL ¬ TRUE;
FOR each: Any ¬ rest, Cdr[each] UNTIL each = NIL DO
WITH TheInteger[Car[each]] SELECT FROM
n: Fixnum => gcd ¬ BigCardinals.BigGCD[BigCardinals.BigFromCard[n­], gcd];
n: Bignum => {
exact ¬ exact AND n.exact;
gcd ¬ BigCardinals.BigGCD[n.magnitude, gcd];
};
ENDCASE => ERROR;
ENDLOOP;
RETURN [MakeBignum[neg: FALSE, mag: gcd, exact: exact, reduce: TRUE]];
};
$truncate => {
result: Any ¬ NIL;
IF IsInteger[a] THEN RETURN [TheInteger[a]];
WITH a SELECT FROM
q: Ratnum => {
result ¬ Arith[quotient, q.numerator, q.denominator]
};
f: Flonum => {
result ¬ MakeFixnum[Real.Fix[f.real]]
};
ENDCASE => Complain[a, "is not real"];
RETURN [ConvertExactness[result, Exact[a]]]
};
$round => {
result: Any ¬ NIL;
IF IsInteger[a] THEN RETURN [TheInteger[a]];
WITH a SELECT FROM
q: Ratnum => {
neg: BOOL ~ Negative[q];
qh: Any ~ Arith[IF neg THEN minus ELSE plus, q, half];
IF IsInteger[qh]
THEN {
result ¬ (IF Odd[qh]
THEN Arith[IF neg THEN plus ELSE minus, qh, MakeFixnum[1]]
ELSE qh);
}
ELSE {
WITH qh SELECT FROM
qh: Ratnum => { result ¬ Arith[quotient, qh.numerator, qh.denominator] };
ENDCASE => ERROR;
};
};
f: Flonum => { result ¬ MakeFixnum[Real.Round[f.real]] };
ENDCASE => Complain[a, "is not real"];
RETURN [ConvertExactness[result, Exact[a]]]
};
$exact => { RETURN [ConvertExactness[a, TRUE]] };
$inexact => { RETURN [ConvertExactness[a, FALSE]] };
ENDCASE => Complain[a, "function is not implemented"];
};

RegisterEssentials: PROC [env: Environment] ~ {
DefinePrimitive[name: "+", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "Binary arithmetic addition", data: NEW[ArithOp ¬ plus]];
DefinePrimitive[name: "-", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "Binary arithmetic subtraction", data: NEW[ArithOp ¬ minus]];
DefinePrimitive[name: "*", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "Binary arithmetic multiplication", data: NEW[ArithOp ¬ mult]];
DefinePrimitive[name: "/", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "Binary arithmetic division", data: NEW[ArithOp ¬ divide]];
DefinePrimitive[name: "quotient", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "integer quotient", data: NEW[ArithOp ¬ quotient]];
DefinePrimitive[name: "remainder", nArgs: 2, dotted: FALSE, proc: ArithPrim, env: env,
doc: "integer remainder with sign of dividend", data: NEW[ArithOp ¬ remainder]];
DefinePrimitive[name: "complex?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $complex, doc: "test for a complex number"];
DefinePrimitive[name: "real?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $real, doc: "test for a real (i.e., non-complex) number"];
DefinePrimitive[name: "rational?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $rational, doc: "test for a rational number"];
DefinePrimitive[name: "integer?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $integer, doc: "test for an integer number"];
DefinePrimitive[name: "exact?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $exact, doc: "test a number for exactness"];
DefinePrimitive[name: "inexact?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $inexact, doc: "test a number for inexactness"];
DefinePrimitive[name: "odd?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $odd, doc: "test an integer for oddness"];
DefinePrimitive[name: "even?", nArgs: 1, dotted: FALSE, proc: NumTypePredPrim, env: env, data: $even, doc: "test an integer for evenness"];
};

RegisterOptionals: PROC [env: Environment] ~ {
DefinePrimitive[name: "+", nArgs: 2, optional: 2, dotted: TRUE, proc: ArithPrim, env: env,
doc: "n-ary arithmetic addition", data: NEW[ArithOp ¬ plus]];
DefinePrimitive[name: "-", nArgs: 2, optional: 1, dotted: TRUE, proc: ArithPrim, env: env,
doc: "n-ary arithmetic subtraction", data: NEW[ArithOp ¬ minus]];
DefinePrimitive[name: "*", nArgs: 2, optional: 2, dotted: TRUE, proc: ArithPrim, env: env,
doc: "n-ary arithmetic multiplication", data: NEW[ArithOp ¬ mult]];
DefinePrimitive[name: "/", nArgs: 2, optional: 1, dotted: TRUE, proc: ArithPrim, env: env,
doc: "n-ary arithmetic division", data: NEW[ArithOp ¬ divide]];
DefinePrimitive[name: "exact->inexact", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $inexact, doc: "convert a number to an inexact number"];
DefinePrimitive[name: "inexact->exact", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $exact, doc: "convert a number to an exact number"];
DefinePrimitive[name: "numerator", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $numerator, doc: "extract the numerator of a rational number"];
DefinePrimitive[name: "denominator", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $denominator, doc: "extract the denominator of a rational number"];
DefinePrimitive[name: "gcd", nArgs: 0, dotted: TRUE, proc: NumFnsPrim, env: env, data: $gcd, doc: "greatest common divisor of integers"];
DefinePrimitive[name: "truncate", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $truncate, doc: "truncate towards zero"];
DefinePrimitive[name: "round", nArgs: 1, dotted: FALSE, proc: NumFnsPrim, env: env, data: $round, doc: "round towards even"];
DefinePrimitive[name: "make-rectangular", nArgs: 2, dotted: FALSE, proc: ComplexPrim, env: env, data: $rectangular, doc: "make a complex number from rectangular coordinates"];
DefinePrimitive[name: "make-polar", nArgs: 2, dotted: FALSE, proc: ComplexPrim, env: env, data: $polar, doc: "make a complex number from polar coordinates"];
DefinePrimitive[name: "real-part", nArgs: 1, dotted: FALSE, proc: ComplexPrim, env: env, data: $realPart, doc: "extract the real part of a complex number"];
DefinePrimitive[name: "imag-part", nArgs: 1, dotted: FALSE, proc: ComplexPrim, env: env, data: $imagPart, doc: "extract the imaginary part of a complex number"];
};

RegisterRealFns: PROC [env: Environment] ~ {
DefinePrimitive[name: "real-fns-sqrt", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $sqrt,
doc: "square root of a real number"];
DefinePrimitive[name: "real-fns-exp", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $exp,
doc: "exponential function of a real number"];
DefinePrimitive[name: "real-fns-expt", nArgs: 2, dotted: FALSE, proc: RealFnsPrim, env: env, data: $expt,
doc: "exponentiation for real numbers"];
DefinePrimitive[name: "real-fns-log", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $log,
doc: "natural logarithm of a real number"];
DefinePrimitive[name: "real-fns-sin", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $sin,
doc: "sin of a real number"];
DefinePrimitive[name: "real-fns-cos", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $cos,
doc: "cosine of a real number"];
DefinePrimitive[name: "real-fns-tan", nArgs: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $tan,
doc: "tangent of a real number"];
DefinePrimitive[name: "real-fns-atan", nArgs: 2, optional: 1, dotted: FALSE, proc: RealFnsPrim, env: env, data: $atan,
doc: "arc-tangent of a real number or a pair of real numbers"];
};

RegisterInit[RegisterEssentials];
RegisterInit[RegisterOptionals];
RegisterInit[RegisterRealFns];

END.

x
SchemeArithmeticImpl.mesa
Copyright Σ 1988, 1989, 1991 by Xerox Corporation.  All rights reserved.
Last changed by Pavel on March 15, 1989 3:06:41 am PST
Michael Plass, December 27, 1990 4:17 pm PST

Arithmetic Primitives
any must represent an exact non-negative integer not exceeding max, or we Complain
Result will be either a Fixnum or a Bignum, or else we Complain
t was in danger of overflow, so proceed cautiously
The second arg is a target; Raise just need to make progress towards the target
Process non-standard number of arguments
Compute and return the appropriate real number that is (perhaps approximately) equal to
(IF negative THEN -1 ELSE 1) * (numerator / denominator) * (radix ^ exponent)
ENABLE Real.RealException => {
msg: ROPE ~ Rope.Cat["arithmetic exception:",
IF flags[invalidOperation] THEN " invalid-operation" ELSE NIL,
IF flags[divisionByZero] THEN " division-by-zero" ELSE NIL,
IF flags[fixOverflow] OR flags[overflow] THEN " overflow" ELSE NIL,
IF flags[underflow] THEN " underflow" ELSE NIL
];
Complain[Cons[a, IF b = undefined THEN NIL ELSE Cons[b, NIL]], msg]
};
Registration of Primitives
Initalization
Κ*Φ–
(cedarcode) style•NewlineDelimiter

™
codeš
œ™Kšœ
Οe
œ=™HK™6K™,K™—š
Οk	˜	Kšœžœ&˜2Kšœ
žœ
˜Ÿ
Kšœžœ˜ Kšœžœ/˜<KšœžœΥ
˜α
—K˜KšΠlnœžœ
ž˜#Kšžœ,˜3Kšžœ˜šœžœ
žœ˜K˜š	œžœžœ3žœžœ˜iK˜——
head™šœžœ˜ K˜—šœžœ
žœžœ!˜JšΟnœžœ
žœžœ
žœžœ˜JKšœžœ
žœžœ	˜$šžœžœ
žœž˜Kšœžœ
žœ˜Kšžœ
˜—Kš
œ˜K˜——š
 
œžœ
žœžœžœ
˜7šžœžœ˜Kšžœ
žœ˜#Kšžœ
žœžœ
žœ˜—Kš
œ˜K˜—š
 œžœ
žœ
žœžœ˜1šžœžœ
ž˜Kšœ
žœ˜Kšœ
žœ˜!Kšœ
žœ	˜Kšœ
žœ˜,Kšžœ%˜,—Kš
œ˜K˜—š œžœ
žœ
˜(šžœžœ
ž˜Kšœ
žœ˜Kšœ
žœ˜Kšœ
žœ˜Kšœ
žœ˜Kšžœ%˜,—Kš
œ˜K˜—š œ˜šžœž˜˜Kšžœ˜—˜	Kšžœ˜—˜šžœžœ
ž˜Kšœžœ˜Kšžœžœ˜!—K˜—˜šžœžœ
ž˜Kšœžœ˜Kšžœžœ˜%—K˜—Kšžœžœ
˜—Kš
œ˜K˜—š 
œžœžœ
˜0šžœžœ
ž˜š
œ˜KšœžœžœΟc5˜KKš
œ?˜?Kšžœžœžœ˜>Kš
œ˜—Kšœžœ˜Kšžœ"˜)—Kš
œ˜K˜—Kšœžœžœ˜Cš
œ"˜"K˜—š œžœ	žœžœ
˜*Kšžœžœžœžœ
˜1K˜K˜—š œžœ
žœžœ
˜HKšœžœžœ˜DKšžœ'žœ
žœ%˜Yšžœžœ˜Kš
œV˜VKš
œ˜—K˜K˜—š 	œžœ
žœžœ
˜@Kšœžœžœ˜Bšžœ#˜%Kšžœ
žœ%˜0šžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜š
œ˜šžœžœ
˜'Kšžœžœ˜-Kšžœžœ˜0——Kšžœ˜$Kš
œ˜——K˜K˜—š
 œžœ
žœžœžœ˜0šžœžœ
ž˜ Kšœžœ˜š
œ˜Kšœžœžœ
žœ
˜KšœCžœ˜Mšžœ	˜Kšžœžœžœ
žœ
žœžœ
žœ˜2Kšžœžœžœ
žœ
žœžœ
žœ˜0—Kš
œ˜—Kšžœžœ
˜—Kš
œ'˜'Kš
œ˜K˜—š
 œžœ
žœžœžœ˜2šžœžœ
ž˜ Kšœžœ	žœ
žœ˜-š
œ˜Kšœžœžœ
žœ
˜Kšœžœžœ
˜KšœGžœžœ˜YKš
žœžœ
žœ	žœžœ˜*Kš
œ˜—Kšžœžœ
˜—Kš
œ'˜'Kš
œ˜K˜—š œžœ
žœžœžœ
žœžœžœ˜EK™Ršžœžœ
ž˜ Kš	œžœ	žœžœ
žœ˜;š
œ˜Kšœžœžœ
žœ
˜Kšžœ
žœžœ'˜<KšœCžœ˜MKšžœžœžœ
žœ	žœ
žœ˜2Kš
œ˜—Kšžœžœ
˜—Kš
œ'˜'Kš
œ˜K˜—š 
œžœ
žœ
žœ˜6šžœžœ
ž˜Kšœžœ˜Kšœ
žœ
˜Kšœ
žœ
˜Kšžœ ˜'—KšžœžœB˜MKš
œ˜K˜—š œžœžœžœ˜9Kšœžœ˜šžœžœ˜!Kš	œžœžœžœ
žœ˜'šžœžœ
žœž˜K˜*Kšœžœ
žœ˜Kšžœ
˜—Kš
œ˜—Kšžœ˜
Kš
œ˜K˜—š œžœžœžœ˜<Kšžœžœžœžœ
žœžœ
žœ˜JKš
œ˜K˜—š
 œžœ
žœ
žœžœ˜0šžœžœ
ž˜Kšœ
žœžœ˜Kšœ
žœ
˜š
œ˜Kšœžœ9˜BKš	œžœžœžœžœ˜&Kšžœ˜
Kš
œ˜—š
œ˜Kšœžœ˜ Kšœžœ˜"Kšœžœa˜jKš	œžœžœžœžœ˜&Kšžœ˜
Kš
œ˜—Kšžœ ˜'—Kš
œ˜K˜—š 	œžœ
žœ
žœ
˜4šžœžœ
ž˜Kšœ
žœ˜Kšžœžœžœžœ˜H—Kš
œ˜K˜—š
 œžœ
žœ
žœžœ˜.šžœžœ
ž˜Kšœ
žœžœ˜Kšœ
žœ˜Kšžœ ˜'—Kš
œ˜K˜—š œžœ
žœžœ˜%šžœžœ
ž˜Kšœ
žœ˜!Kšœ
žœ$˜7Kšžœžœ
˜—Kš
œ˜K˜—š
 œžœžœžœžœ˜*Kš
œ"˜"Kšžœžœžœ˜Kš
œ˜K˜—Kšœžœ˜6š
 œžœ
žœžœžœ˜5Kšœžœ˜šžœžœ
žœž˜Kšœžœ˜Kšžœžœžœ
žœ˜)K˜Kšžœ
˜—Kšžœ‘(˜/Kš
œ˜K˜—š œžœžœžœžœžœ˜2š	œžœžœ
ž	œ
žœ˜-Kšœžœžœžœ˜B—Kšœžœ˜!Kšžœ˜Kš
œ˜K˜—š 
œžœ
žœ
žœ
˜2K™?šžœžœ
ž˜Kšœ
žœ˜Kšœ
žœ˜š
œ˜Kšœžœ
˜šžœ
žœ ˜&šžœ˜Kšœžœ
˜Kšœžœ˜š	žœ
žœžœ
žœž˜K˜
K˜
Kšžœ
˜—Kšœ	žœ&˜5šžœ
žœ
‘1˜:šžœ˜šžœžœ
žœž˜K˜KKšžœ
˜—Kš
œ
˜
—KšžœG˜K—K˜Kšžœ	˜Kš
œ
˜
—šžœ
žœ
žœžœ˜.Kšœ	žœ+˜:Kš
œ˜——Kšžœ
žœ
žœžœ˜AKš
œ˜—Kšžœžœ
˜—Kš
œ˜Kš
œ˜K˜—š
 	œžœ
žœ
žœžœ˜2šžœžœ
ž˜Kšœ
žœžœ˜š
œ˜šžœžœ
ž˜Kšœžœžœ˜ š
œ˜Kš
žœ
žœ&žœ
žœžœ˜?Kš
žœžœžœ
žœžœ˜@Kš
œ˜—Kšžœžœ
˜—Kš
œ˜—Kšžœžœ
˜—Kšžœžœ
˜Kš
œ˜K˜—š œ˜"K˜šžœžœ
ž˜Kšœ
žœžœžœ\žœžœžœžœžœžœžœžœ˜δ
š
œ˜šžœž˜
Kš	œ
žœžœ	žœžœ˜3Kš	œžœžœ	žœžœ˜5Kšœžœ˜Kšœžœžœ
žœ˜3Kšœ	žœžœ
žœ˜/Kš	œ
žœžœžœ
žœ˜BKšœžœžœ
žœ˜/š
œ˜Kšœ
žœžœžœ˜,Kšžœžœžœžœ˜%Kš
œ˜—Kšžœžœ
˜—Kš
œ˜—Kšžœžœžœ>žœ˜a—Kšžœ˜Kš
œ˜K˜—š œžœžœ
˜7šžœžœ
ž˜š
œ˜šžœ˜Kšžœ
žœ!˜,šžœ˜Kšœžœ˜Kšœžœ˜K˜1šžœ
žœžœ
ž˜6K˜
K˜
K•StartOfExpansion:[in1: 
BigCardinals.BigCARD, in2: 
BigCardinals.BigCARD]˜,Kšžœ
˜—šžœ
žœž˜'Kš
œ2™2K˜K–:[in1: 
BigCardinals.BigCARD, in2: 
BigCardinals.BigCARD]˜'Kšžœ
˜—K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šžœžœžœžœžœžœžœžœ
žœ˜Ξ
Kš
œ˜——Kš
œ˜—˜Kšžœžœ:˜EK˜—Kšžœžœ
˜—šžœžœžœ˜-Kšžœžœ;˜FKš
œ˜—Kš
œ%˜%Kš
œ˜Kš
œO™OK˜—šœžœ
žœžœ
žœžœ
žœžœ
žœžœ#žœ&žœ ˜ω
K˜—š
 œžœžœžœžœ
˜Cš
 œžœžœžœžœ˜Išœžœ
žœ
ž˜K˜
K˜Kšžœ	˜—K˜—Kšœžœ˜šžœž˜K˜K˜K˜K˜Kš	œžœžœžœžœ˜3Kšœžœ'˜8Kšžœžœ
˜—Kšžœžœ
žœžœ˜'Kšžœžœžœ˜<Kš
œ˜K˜—Kšœ8žœ
žœ˜Cš 
œžœžœ$žœ
žœžœžœ
˜kšžœžœžœ0žœ˜MKšœžœ˜%Kšžœžœ˜Kšžœ˜Kš
œ˜—Kšžœžœ/˜:Kš
œ˜K˜—š
 œžœ-žœžœžœ
˜\K˜)Kšœžœ	˜K˜)Kšœžœ	˜š
ž˜šžœž˜š
œ	˜	Kšžœ
žœ
žœžœ˜:K˜'Kš
œ˜—š
œ
˜
Kšžœ
žœ
žœžœ˜9–:[in1: 
BigCardinals.BigCARD, in2: 
BigCardinals.BigCARD]šžœ%ž˜/K–U[large: 
BigCardinals.BigCARD, small: 
BigCardinals.BigCARD, reuse: 
BOOL _ FALSE]˜IK–U[large: 
BigCardinals.BigCARD, small: 
BigCardinals.BigCARD, reuse: 
BOOL _ FALSE]šœ,žœ˜4K–U[large: 
BigCardinals.BigCARD, small: 
BigCardinals.BigCARD, reuse: 
BOOL _ FALSE]šœLžœ˜WKšžœžœ
˜—Kš
œ˜—š
œ	˜	K˜,Kšœžœ˜.Kš
œ˜—Kšœžœžœ
˜=š
œ˜Kšœžœžœžœžœ
žœžœžœ˜JKšœžœžœžœžœ
žœžœžœ˜JK˜5šžœžœ˜Kšœžœžœ%žœ%˜^Kš
œ˜—Kšžœžœ
žœžœžœžœ˜AKšžœ˜Kš
œ˜—š
œ
˜
KšœCžœžœ%˜ˆ
Kšœžœ˜.K˜—š
œ˜KšœCžœžœ%˜ˆ
K˜—Kšžœžœ
˜—Kšžœ
˜Kšžœ
˜—Kšžœ2žœ˜UKš
œ˜K˜—Kšœžœžœ	žœ!˜_Kšœžœžœ	žœ!˜_Kšœžœ"žœ˜>š 
œžœžœžœ
˜DKš
œP˜Pšžœžœ
žœ
žœžœ:žœE˜Ά
Kšžœ
ž˜	šžœ˜Kš
œN˜NKš
œR˜RKšœžœžœ˜BKšžœ@žœ
žœ%˜rKšœžœžœ˜=Kšœžœžœ	žœ˜@Kš
œ˜——Kšžœžœ1˜<Kš
œ˜K˜—š 
œžœ%žœ
˜IKšœžœ˜#Kšœžœ˜'Kšœžœ˜#Kšœžœ˜'Kšœžœ
˜Kšœžœ
˜šžœž˜š
œ	˜	Kšœžœ!žœ˜>Kšœžœ!žœ˜>Kšœžœžœ˜3Kšœžœ#žœ˜9Kš
œ˜—š
œ
˜
Kšœžœ!žœ˜>Kšœžœ!žœ˜>Kšœžœ žœ˜4Kšœžœ#žœ˜9Kš
œ˜—š
œ	˜	Kšœžœžœ˜3Kšœžœ#žœ˜9Kš
œ˜—š
œ˜Kšœžœ!žœ˜5Kšœžœ!žœ˜7Kš
œ˜—š
œ
˜
Kš
žœžœ*žœ.žœžœ˜zKš
œ˜—š
œ˜Kšœžœžœ"žœžœ
žœ
žœžœ˜XKšœžœžœ"žœžœ
žœ
žœžœ˜XK˜5šžœžœ˜Kšœžœ!žœ˜>Kšœžœ!žœ˜?Kšžœ$˜*Kš
œ˜—Kšžœ˜Kš
œ˜—Kšžœžœ
˜—Kšžœ!žœ
˜4Kš
œ˜K˜—š œžœ'žœ
˜JKšœžœ
˜Kšœžœ
˜Kšœžœžœ	˜"šžœž˜K˜Pš
œ	˜	K˜FK˜EKš
œ˜—š
œ˜Kš
œC˜CKš
œD˜DKš
œE˜EK˜ K˜ Kš
œ˜—š
œ
˜
Kš
žœžœ"žœ"žœžœ˜gKš
œ˜—Kšœ$žœ,˜SKšžœžœ
˜—Kšžœ1žœžœ
žœ%˜Kšžœžœm˜xKš
œ˜K˜—K˜š œžœ
žœžœ
˜BKš
œžœžœžœžœ
žœžœ
˜Nšžœžœ
ž˜š
œ˜šžœžœ
ž˜š
œ˜Kšœžœ˜
Kšœžœ˜
šžœž˜š
œ	˜	šžœ˜	Kšžœžœžœžœ
žœžœ
žœ˜AKšžœžœžœžœ
žœžœ
žœ˜C—K˜—š
œ
˜
šžœ˜	Kšžœžœžœžœ
žœžœ
žœ˜AKšžœžœžœžœ
žœžœ
žœ˜C—Kš
œ˜—Kš
œ
žœ
žœ
žœžœžœ
žœ˜Iš
œ˜Kšžœžœ!˜.Kšžœžœžœ
žœ˜-Kš
œ˜—š
œ
˜
Kšžœžœžœ
žœ˜2Kš
œ˜—š
œ˜Kš
žœžœžœ
žœžœ˜6Kš
œ˜—Kš	œžœžœžœžœ
˜5Kšœ
žœ/˜BKšžœžœ
˜—Kš
œ˜—Kšžœžœ
˜—Kš
œ˜—Kšžœžœ
˜—š‘*œ˜,Kšœ$žœžœ
˜1šžœžœ
ž˜Kšœžœ˜K˜@Kšžœžœ
˜—šžœžœ
ž˜Kšœžœ˜K˜@Kšžœžœ
˜—š
žœ
žœžœ	žœ
žœ˜0šžœ
žœ	˜Kšžœžœ2˜>šžœ˜Kš
œ6˜6Kšžœ
žœ
žœ
žœ	˜$Kš
œ˜——Kš
œ˜—K˜—š‘1œ˜3Kšœžœžœžœ˜?Kšœžœžœžœ˜?Kšžœžœ‘k˜›
šžœž˜Kšžœžœžœ
˜/Kšžœžœžœ
˜/Kšžœ
˜—šžœž˜Kšœ
žœžœžœ˜9Kšœ
žœžœžœ˜;Kšœžœžœžœ˜;Kšœžœ‘˜(Kšžœžœ
˜—Kš
œ˜—Kš
œ˜K˜—š 	œ˜Kšœžœžœ˜.šžœžœžœ˜K™(šžœ˜šžœ˜Kš	œžœžœžœžœ˜AKšœžœžœ
žœ˜*K˜
Kš
œ
˜
—šžœ˜Kšœžœžœžœ˜Jšžœžœ
ž˜K˜Kšœžœ
˜Kšžœ
˜—Kš
œ
˜
——Kš
œ˜—K˜Kš
œ˜K˜—š œžœ
žœžœ:žœ	žœ	žœžœ
˜Ž
™WK™M—K˜2Kšœžœ˜3K˜&K˜šžœ
žœ
˜Kšžœ˜
—šžœ˜K˜K˜K˜š œžœžœ
˜2šžœ!žœ
˜)Kšžœ˜—–[a: 
Scheme.Any]šžœ
žœžœ
˜Kšžœ=˜C—šžœ˜K˜7Kšžœ˜ Kš
œ˜—K˜—Kšœ2žœ
˜BK˜Kšžœžœ
žœžœ˜DKš
œ˜—K˜K˜—š
 œžœ
žœžœžœ
˜Ešžœ˜Kšžœ
žœ˜šžœ˜šžœžœ
ž˜K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šœ
žœ8žœ˜dKšœ
žœ:˜M–=[num: 
Scheme.Bignum, denom: 
Scheme.Bignum, exact: 
BOOL]š
œ˜šžœžœ
˜Kšžœ
žœ)˜4Kšžœ
žœžœ.˜>—Kš
œ˜—K–=[num: 
Scheme.Bignum, denom: 
Scheme.Bignum, exact: 
BOOL]šœ
žœžœB˜ZK–=[num: 
Scheme.Bignum, denom: 
Scheme.Bignum, exact: 
BOOL]šœžœžœd˜}Kšžœžœ
˜—Kš
œ˜——K˜K˜—š
 œžœ
žœžœžœ˜<Kšžœ˜%Kš
œ˜K˜—š œ˜šžœ™šœžœ$™-Kšžœžœžœ
žœ
™>Kšžœžœžœ
žœ
™;Kš
žœžœžœ
žœ
žœ
™CKšžœžœžœ
ž™.K™—Kšœžœžœ
žœ
žœ	žœ™CKš
œ™—Kšœžœ˜Kšœžœžœ
˜Kšœžœ˜Kšœžœ
˜š	žœ
žœžœ
žœž˜:Kšœ$žœ˜=K˜&š
œ
˜
Kšœžœ˜Kšœ
žœ
žœžœ˜9Kš
œ˜—K–[REAL]˜%K–[REAL]˜&K–[REAL]˜&K–[REAL]˜&–[REAL]š
œ
˜
šžœ˜Kšžœ$˜(šžœ˜Kšœžœ˜Kšœ
žœ
žœžœ˜:Kš
œ˜——Kš
œ˜—Kšžœžœ
˜—Kšžœžœžœžœ
žœ
žœ	žœ!˜vKšœžœžœ˜:Kšžœžœ
žœžœžœ!žœ
žœ˜eK˜K˜—š 
œ˜šžœž˜–[REAL]š
œ˜Kšžœžœ
žœ˜ šžœžœ
ž˜Kšœ
žœ˜!Kšžœ#˜*—Kš
œ˜—–[REAL]š
œ˜Kšžœžœ
žœ˜,šžœžœ
ž˜Kšœ
žœ˜#Kšžœ#˜*—Kš
œ˜—š
œ	˜	K˜.Kšœžœžœ
˜šžœžœžœ
ž˜3šžœžœ
ž˜&K˜Jš
œ˜Kšœžœ	˜K˜,K˜—Kšžœžœ
˜—Kšžœ
˜—K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šžœžœ"žœ˜FKš
œ˜—š
œ˜K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šœžœ
˜K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šžœžœ
žœ˜,šžœžœ
ž˜š
œ˜K˜4K˜—š
œ˜K˜%K˜—Kšžœ˜&—Kšžœ%˜+Kš
œ˜—š
œ˜K–P[neg: 
BOOL, mag: 
BigCardinals.BigCARD, exact: 
BOOL, reduce: 
BOOL _ TRUE]šœžœ
˜Kšžœžœ
žœ˜,šžœžœ
ž˜š
œ˜Kšœžœ˜Kšœžœžœžœ˜6šžœ˜šžœ˜šœ
žœ˜Kšžœžœžœžœ˜:Kšžœ˜	—Kš
œ
˜
—šžœ˜šžœžœ
ž˜K˜IKšžœžœ
˜—Kš
œ˜——K˜—K˜9Kšžœ˜&—Kšžœ%˜+Kš
œ˜—Kšœžœžœ˜1Kšœžœžœ˜4Kšžœ/˜6—K˜K˜——š
 ™š œžœ˜/Kšœ-žœFžœ˜
Kšœ-žœIžœ˜‘
Kšœ-žœLžœ˜“
Kšœ-žœFžœ˜
Kšœ4žœ<žœ˜Ž
Kšœ5žœSžœ˜§
Kšœ4žœU˜Ž
Kšœ1žœc˜™
Kšœ5žœW˜‘
Kšœ4žœV˜
Kšœ2žœU˜Œ
Kšœ4žœY˜’
Kšœ0žœS˜ˆ
Kšœ1žœU˜‹
Kš
œ˜K˜—š œžœ˜.Kšœ:žœEžœ˜˜
Kšœ:žœHžœ˜œ
Kšœ:žœKžœ˜ž
Kšœ:žœEžœ˜š
Kšœ:žœ\˜›
Kšœ:žœX˜—
Kšœ5žœc˜
Kšœ7žœg˜£
Kšœ/žœV˜‰
Kšœ4žœM˜†
Kšœ1žœG˜}Kšœ<žœn˜―
Kšœ6žœb˜
Kšœ5žœb˜œ
Kšœ5žœg˜‘
Kš
œ˜K˜—š œžœ˜,Kšœ9žœQ˜
Kšœ8žœY˜–
Kšœ9žœT˜’
Kšœ8žœV˜“
Kšœ8žœH˜…
Kšœ8žœK˜ˆ
Kšœ8žœL˜‰
KšœFžœk˜Ά
Kš
œ˜K˜——™
Kš
œ!˜!K˜ Kš
œ˜K˜—Kšžœ
˜K˜—…—vμ¦: