<> <> <<>> DIRECTORY Rope, Ieee, PrincOpsUtils, Process, RuntimeError, IO, Basics, Atom, Real, BigCardinals, AlgebraClasses, BigCardExtras, MathExpr, MathConstructors, Bools, Ints, BigRats; BigRatsImpl: CEDAR PROGRAM IMPORTS Rope, Basics, Ieee, IO, PrincOpsUtils, Process, RuntimeError, BigCardinals, AlgebraClasses, BigCardExtras, MathConstructors, Ints EXPORTS BigRats = BEGIN OPEN BigRats, BC: BigCardinals, AC: AlgebraClasses, BCE: BigCardExtras; <> BigRatsError: PUBLIC ERROR [reason: ATOM _ $Unspecified] = CODE; bitsPerWord: CARDINAL = Basics.bitsPerWord; CARD: TYPE = LONG CARDINAL; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Object: TYPE = AC.Object; Method: TYPE = AC.Method; <> PrintName: PUBLIC AC.ToRopeOp = { RETURN["BigRats"]; }; ShortPrintName: PUBLIC AC.ToRopeOp = { RETURN["Q"]; }; Characteristic: PUBLIC AC.StructureRankOp = { RETURN[ 0 ] }; <> <> <> <> <> <> <> <> <<}>> <> <> <> <<[out.num, dummy] _ BC.BigDivMod[ num, gcd];>> <<[out.den, dummy] _ BC.BigDivMod[ den, gcd]>> <<}>> <<};>> <<>> <> <> <> <> <> <> <> <<}>> <> <> <> <> <> <<[out.num, dummy] _ BC.BigDivMod[ bignum, gcd];>> <<[out.den, dummy] _ BC.BigDivMod[ bigden, gcd]>> <<}>> <<};>> FromPairBC: PUBLIC PROC [num, den: BigCard, less: BOOL _ FALSE] RETURNS [BigRat] = { RETURN [Simplify[Breed[num, den, less]]]; }; FromPairLC: PUBLIC PROC [num, den: CARD, less: BOOL _ FALSE] RETURNS [BigRat] = { RETURN [Simplify[Breed[BCE.LCToBC[num], BCE.LCToBC[den], less]]]; }; FromBC: PUBLIC PROC [bc: BigCard, less: BOOL _ FALSE] RETURNS [BigRat] = { RETURN [Breed[bc, BigCardOne, less]]; }; FromLC: PUBLIC PROC [lc: CARD, less: BOOL _ FALSE] RETURNS [BigRat] = { IF Basics.HighHalf[lc] = 0 AND NOT less THEN SELECT Basics.LowHalf[lc] FROM 0 => RETURN [RatZero]; 1 => RETURN [RatOne]; ENDCASE; RETURN [Breed[BCE.LCToBC[lc], BigCardOne, less]]; }; <> Recast: PUBLIC AC.BinaryOp = { <> IF AC.StructureEqual[firstArg.class, BigRats] THEN RETURN[firstArg]; IF Ints.CanRecast[firstArg, Ints.Ints] THEN RETURN[ FromRope[Ints.ToRope[ Ints.Recast[firstArg, Ints.Ints] ] ] ]; RETURN[NIL]; }; CanRecast: PUBLIC AC.BinaryPredicate = { firstArgStructure: Object _ IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN firstArg ELSE ERROR; SELECT TRUE FROM AC.StructureEqual[firstArgStructure, BigRats] => RETURN[TRUE]; Ints.CanRecast[firstArg, Ints.Ints] => RETURN[TRUE]; ENDCASE; RETURN[FALSE]; }; LegalFirstChar: PUBLIC AC.LegalFirstCharOp = { SELECT char FROM IN ['0..'9] => RETURN[TRUE]; '+, '- => RETURN[TRUE]; ENDCASE; RETURN[Ints.LegalFirstChar[char, structure] ]; }; Read: PUBLIC AC.ReadOp ~ { <> num, den: BC.BigCARD; bigCARDRope: Rope.ROPE; tokenKind: IO.TokenKind; charsSkipped: INT; -- dummy output parm for GetTokenRope sign: Basics.Comparison _ greater; []_ in.SkipWhitespace[]; IF in.PeekChar[ ]='- THEN { sign _ less; [] _ in.GetChar[ ]; } ELSE IF in.PeekChar[ ]='+ THEN { sign _ greater; [] _ in.GetChar[ ]; }; [tokenKind, bigCARDRope, charsSkipped] _ in.GetCedarTokenRope[]; IF tokenKind#tokenDECIMAL THEN ERROR IO.Error[$SyntaxError, in]; num _ BC.BigFromDecimalRope[bigCARDRope]; []_ in.SkipWhitespace[]; IF in.EndOf[] THEN { IF BC.BigZero[num] THEN out _ RatZero ELSE out _ FromPairBC[num, BigCardOne, sign=less]; RETURN[out]; }; IF in.PeekChar[]='. THEN IO.Error[$SyntaxError, in]; -- no decimal points allowed IF in.PeekChar[ ]#'/ THEN -- Next char is neither . nor / IF BC.BigZero[num] THEN out _ RatZero ELSE out _ FromPairBC[num, BigCardOne, sign=less] ELSE { [ ] _ in.GetChar[ ]; -- toss /; []_ in.SkipWhitespace[]; <<[bigCARDRope, charsSkipped] _ in.GetTokenRope[];>> [tokenKind, bigCARDRope, charsSkipped] _ in.GetCedarTokenRope[]; IF tokenKind#tokenDECIMAL THEN ERROR BigRatsError[$BadToken]; den _ BC.BigFromDecimalRope[bigCARDRope]; IF BC.BigZero[num] THEN out _ RatZero ELSE out _ FromPairBC[ num, den, sign=less ]; }; RETURN[out]; }; <> <> <> <> <<};>> <<>> FromRope: PUBLIC AC.FromRopeOp = { rope: ROPE _ in; less: BOOL _ Rope.Match["-*", rope]; pos: INT _ 0; len: INT _ 0; IF less THEN rope _ Rope.Substr[rope, 1]; len _ Rope.Length[rope]; pos _ Rope.SkipTo[rope, 0, "/"]; IF pos # len THEN { <> num: ROPE _ Rope.Substr[rope, 0, pos]; den: ROPE _ Rope.Substr[rope, pos+1]; RETURN [FromPairBC[ BigCardinals.BigFromDecimalRope[num], BigCardinals.BigFromDecimalRope[den], less]]; }; pos _ Rope.SkipTo[rope, 0, "."]; IF pos < len THEN { <> whole: ROPE _ Rope.Substr[rope, 0, pos]; fract: ROPE _ Rope.Substr[rope, pos+1]; fractPlaces: INT _ Rope.Length[fract]; number: BigCard _ BigCardinals.BigFromDecimalRope[Rope.Concat[whole, fract]]; tens: BigCard _ InternalBCPower[BigCardOne, BigCardTen, fractPlaces]; RETURN [FromPairBC[number, tens, less]]; }; <> RETURN [FromBC[BigCardinals.BigFromDecimalRope[rope], less ] ]; }; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> ToRope: PUBLIC AC.ToRopeOp = { rat: BigRatData _ NARROW[in.data]; IF rat.sign = equal THEN RETURN ["0"]; IF rat.den.size = 1 AND rat.den.contents[0] = 1 THEN { RETURN [Rope.Cat[ IF rat.sign = less THEN "-" ELSE NIL, BigCardinals.BigToDecimalRope[rat.num] ]]; }; RETURN [Rope.Cat[ IF rat.sign = less THEN "-" ELSE NIL, BigCardinals.BigToDecimalRope[rat.num], "/", BigCardinals.BigToDecimalRope[rat.den] ]]; }; Write: PUBLIC AC.WriteOp = { IO.PutRope[ stream, ToRope[in] ] }; ToRopeApprox: PUBLIC PROC [rat: BigRat, places: NAT _ 3] RETURNS [ROPE] = { ratData: BigRatData _ NARROW[rat.data]; ros: STREAM = IO.ROS[]; left, right: BigCard; rat1000: BigRat _ FromLC[1000]; placesRat: BigRat _ BCToTheX[BigCardTen, places]; placesRatData: BigRatData _ NARROW[placesRat.data]; IF ratData.sign = less THEN IO.PutChar[ros, '-]; [left, rat] _ Truncate[rat]; [right, rat] _ Truncate[Multiply[rat, placesRat]]; IF Compare[rat, RatHalf] # less THEN { right _ BigCardinals.BigAdd[right, BigCardinals.BigFromSmall[1]]; IF BigCardinals.BigCompare[right, placesRatData.num] = equal THEN { left _ BigCardinals.BigAdd[right, BigCardinals.BigFromSmall[1]]; right _ BigCardinals.BigFromSmall[0]; }; }; IO.PutRope[ros, BigCardinals.BigToDecimalRope[left]]; IF right.size # 0 THEN { rope: ROPE _ BigCardinals.BigToDecimalRope[right]; IO.PutChar[ros, '.]; THROUGH [Rope.Length[rope]..places) DO IO.PutChar[ros, '0]; ENDLOOP; IO.PutRope[ros, rope]; }; RETURN [IO.RopeFromROS[ros]]; }; <> <> <> <> <> <> <> <> <> <> <<};>> <> <<}>> <<};>> <<>> ToExpr: PUBLIC PROC [in: BigRat] RETURNS [MathExpr.EXPR] = { -- should be made public inData: BigRatData _ NARROW[in.data]; numRope: Rope.ROPE _ BC.BigToDecimalRope[inData.num]; denRope: Rope.ROPE _ BC.BigToDecimalRope[inData.den]; IF inData.sign = equal THEN RETURN [MathConstructors.MakeInt["0"]]; IF inData.sign = less THEN numRope _ Rope.Concat["-", numRope]; IF BCE.BigOne[inData.den] THEN RETURN [MathConstructors.MakeInt[numRope] ]; RETURN[MathConstructors.MakeFraction[MathConstructors.MakeInt[numRope], MathConstructors.MakeInt[denRope] ] ] }; <> <> <> <> <> <> <> <> <> <> <<[type: ty, fr: z, exp10: exp] _ Real.RealToPair[in, precision];>> <> < ERROR BigRatsError[$BigRatFromREALnan];>> < ERROR BigRatsError[$BigRatFromREALinfinity];>> < RETURN[ RatZero ];>> < {>> <> <> <> <<}>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <> <<};>> <<};>> <<>> <> <> <> <> <> <> <<};>> <<>> FromReal: PUBLIC PROC [real: REAL] RETURNS [BigRat] = { ext: Ieee.Ext = Ieee.Unpack[real]; SELECT ext.det.type FROM normal => { expRat: BigRat _ TwoToTheX[ext.exp-31, real < 0.0]; mantRat: BigRat _ FromLC[ext.frac.lc]; RETURN [Multiply[expRat, mantRat]]; }; zero => RETURN [RatZero]; ENDCASE => ERROR; }; ToReal: PUBLIC PROC [rat: BigRat] RETURNS [REAL] = { ratData: BigRatData _ NARROW[rat.data]; SELECT TRUE FROM ratData.sign = equal => RETURN [0.0]; Equal[rat, RatOne] => RETURN [1.0]; ENDCASE => { numFirst: INT _ BCE.FirstOneBit[ratData.num]; denFirst: INT _ BCE.FirstOneBit[ratData.den]; exp: INTEGER _ numFirst-denFirst; scale: BigRat _ TwoToTheX[31 - exp]; adjusted: BigRat _ Multiply[rat, scale]; adjustedData: BigRatData _ NARROW[adjusted.data]; quo, rem: BigCard; [quo, rem] _ BigCardinals.BigDivMod[adjustedData.num, adjustedData.den, FALSE]; SELECT BigCardinals.BigCompare[BigCardinals.BigAdd[rem, rem], adjustedData.den] FROM equal, greater => { quo _ BigCardinals.BigAdd[quo, BigCardOne]; IF quo.size = 3 THEN { <> quo _ BigCardinals.BigDivMod[quo, BigCardinals.BigFromSmall[2]].quo; exp _ exp + 1; }; }; ENDCASE; SELECT quo.size FROM 2 => TRUSTED { <> ln: Basics.LongNumber _ [pair[lo: quo.contents[0], hi: quo.contents[1] ]]; ext: Ieee.Ext _ [det: [sign: ratData.sign = less, sticky: FALSE, blank: 0, type: normal], exp: exp, frac: ln]; WHILE ext.frac.li > 0 DO ext.frac _ Basics.DoubleShiftLeft[ext.frac, 1]; ext.exp _ ext.exp - 1; ENDLOOP; IF ext.exp < Ieee.DenormalizedExponent THEN { WHILE ext.exp < Ieee.DenormalizedExponent+1 DO ext.frac _ Basics.DoubleShiftRight[ext.frac, 1]; ext.exp _ ext.exp + 1; ENDLOOP; ext.exp _ ext.exp - 1; }; RETURN [Ieee.Pack[@ext]]; }; ENDCASE => ERROR; }; }; Truncate: PUBLIC PROC [rat: BigRat] RETURNS [fix: BigCard, rem: BigRat] = { ratData: BigRatData _ NARROW[rat.data]; SELECT BigCardinals.BigCompare[ratData.num, ratData.den] FROM less => RETURN [BigCardZero, rat]; equal => RETURN [BigCardOne, RatZero]; greater => { mod: BigCard; [fix, mod] _ BigCardinals.BigDivMod[ratData.num, ratData.den]; rem _ FromPairBC[mod, ratData.den]; }; ENDCASE => ERROR; }; <> Template: PROC [] RETURNS [BigRat] ~ { RETURN [NEW[AC.ObjectRec _ [class: BigRats, flavor: StructureElement, data: NEW[BigRatDataRec _ [sign: equal, num: BC.Zero, den: BC.Zero]]]]]; }; Zero: PUBLIC AC.NullaryOp = { RETURN[ RatZero ] }; One: PUBLIC AC.NullaryOp = { RETURN[ RatOne ] }; Add: PUBLIC AC.BinaryOp ~ { <> firstData: BigRatData _ NARROW[firstArg.data]; secondData: BigRatData _ NARROW[secondArg.data]; ratResult: BigRat _ Template[]; ratResultData: BigRatData _ NARROW[ratResult.data]; prod1, prod2, denomGCD, cofactor1, cofactor2, dummy, sum, nextGCD, quot: BC.BigCARD; IF firstData.sign = equal THEN RETURN[secondArg]; -- firstData equal IF secondData.sign = equal THEN RETURN[firstArg]; -- secondData equal IF Integer[firstArg] AND Integer[secondArg] THEN { -- both args integers IF firstData.sign # secondData.sign THEN { relation: Basics.Comparison _ BC.BigCompare[firstData.num, secondData.num]; IF relation = greater THEN { ratResultData.num _ BC.BigSubtract[ firstData.num, secondData.num]; ratResultData.sign _ firstData.sign } ELSE { ratResultData.num _ BC.BigSubtract[ secondData.num, firstData.num]; ratResultData.sign _ secondData.sign } } ELSE { ratResultData.num _ BC.BigAdd[ firstData.num, secondData.num ]; ratResultData.sign _ firstData.sign }; ratResultData.den _ BC.BigFromSmall[1]; IF BC.BigZero[ ratResultData.num] THEN ratResultData.sign _ equal; RETURN[ratResult]; }; IF Integer[firstArg] THEN { prod1 _ BC.BigMultiply[ firstData.num, secondData.den ]; IF firstData.sign # secondData.sign THEN { relation: Basics.Comparison _ BC.BigCompare[prod1, secondData.num]; IF relation = greater THEN { ratResultData.num _ BC.BigSubtract[ prod1, secondData.num]; ratResultData.sign _ firstData.sign } ELSE { ratResultData.num _ BC.BigSubtract[ secondData.num, prod1]; ratResultData.sign _ secondData.sign } } ELSE { ratResultData.num _ BC.BigAdd[prod1, secondData.num]; ratResultData.sign _ firstData.sign }; ratResultData.den _ secondData.den; RETURN[ratResult]; }; IF Integer[secondArg] THEN { prod2 _ BC.BigMultiply[ secondData.num, firstData.den ]; IF secondData.sign # firstData.sign THEN { relation: Basics.Comparison _ BC.BigCompare[prod2, firstData.num]; IF relation = greater THEN { ratResultData.num _ BC.BigSubtract[ prod2, firstData.num]; ratResultData.sign _ secondData.sign } ELSE { ratResultData.num _ BC.BigSubtract[ firstData.num, prod2]; ratResultData.sign _ firstData.sign } } ELSE { ratResultData.num _ BC.BigAdd[ prod2, firstData.num ]; ratResultData.sign _ secondData.sign }; ratResultData.den _ firstData.den; RETURN[ratResult]; }; denomGCD _ BC.BigGCD[ firstData.den, secondData.den ]; -- general case [cofactor1, dummy] _ BC.BigDivMod[ firstData.den, denomGCD]; [cofactor2, dummy] _ BC.BigDivMod[ secondData.den, denomGCD]; prod1 _ BC.BigMultiply[ firstData.num, cofactor2 ]; prod2 _ BC.BigMultiply[ secondData.num, cofactor1 ]; IF firstData.sign # secondData.sign THEN { relation: Basics.Comparison _ BC.BigCompare[prod1, prod2]; IF relation = greater THEN { sum _ BC.BigSubtract[ prod1, prod2]; ratResultData.sign _ firstData.sign } ELSE { sum _ BC.BigSubtract[ prod2, prod1]; ratResultData.sign _ secondData.sign } } ELSE { sum _ BC.BigAdd[ prod1, prod2 ]; ratResultData.sign _ firstData.sign }; IF BC.BigZero[sum] THEN { ratResultData.sign _ equal; ratResultData.num _ sum; ratResultData.den _ BC.BigFromSmall[1]; }; quot _ firstData.den; -- need quot to avoid changing firstData.den IF NOT BCE.BigOne[denomGCD] THEN { nextGCD _ BC.BigGCD[ sum, denomGCD ]; IF NOT BCE.BigOne[nextGCD] THEN { [sum, dummy] _ BC.BigDivMod[ sum, nextGCD]; [quot, dummy] _ BC.BigDivMod[ quot, nextGCD] } }; ratResultData.num _ sum; ratResultData.den _ BC.BigMultiply[ quot, cofactor2 ]; RETURN[ratResult]; }; Negate: PUBLIC AC.UnaryOp ~ { argData: BigRatData _ NARROW[arg.data]; ratResult: BigRat _ Template[]; ratResultData: BigRatData _ NARROW[ratResult.data]; IF argData.sign = less THEN ratResultData.sign _ greater ELSE IF argData.sign = greater THEN ratResultData.sign _ less ELSE ratResultData.sign _ equal; ratResultData.num _ BC.BigCopy[argData.num]; ratResultData.den _ BC.BigCopy[argData.den]; RETURN[ratResult]; }; Subtract: PUBLIC AC.BinaryOp ~ { RETURN[ Add[ firstArg, Negate[ secondArg ] ] ]; }; Multiply: PUBLIC AC.BinaryOp ~ { <> firstData: BigRatData _ NARROW[firstArg.data]; secondData: BigRatData _ NARROW[secondArg.data]; ratResult: BigRat _ Template[]; ratResultData: BigRatData _ NARROW[ratResult.data]; firstGCD, cofactor1, cofactor2, dummy, secondGCD, cofactor3, cofactor4: BC.BigCARD; IF firstData.sign = equal OR secondData.sign = equal THEN RETURN[ RatZero ]; IF Integer[firstArg] AND Integer[secondArg] THEN { -- both args integers ratResultData.num _ BC.BigMultiply[ firstData.num, secondData.num ]; ratResultData.den _ BC.BigFromSmall[1]; IF firstData.sign # secondData.sign THEN ratResultData.sign _ less ELSE ratResultData.sign _ greater; RETURN[ratResult]; }; IF Integer[firstArg] THEN { firstGCD _ BC.BigGCD[ firstData.num, secondData.den ]; [cofactor1, dummy] _ BC.BigDivMod[ firstData.num, firstGCD]; [cofactor2, dummy] _ BC.BigDivMod[ secondData.den, firstGCD]; ratResultData.num _ BC.BigMultiply[ cofactor1, secondData.num ]; ratResultData.den _ cofactor2; IF firstData.sign # secondData.sign THEN ratResultData.sign _ less ELSE ratResultData.sign _ greater; RETURN[ratResult]; }; IF Integer[secondArg] THEN { firstGCD _ BC.BigGCD[ secondData.num, firstData.den ]; [cofactor1, dummy] _ BC.BigDivMod[ secondData.num, firstGCD]; [cofactor2, dummy] _ BC.BigDivMod[ firstData.den, firstGCD]; ratResultData.num _ BC.BigMultiply[ cofactor1, firstData.num ]; ratResultData.den _ cofactor2; IF firstData.sign # secondData.sign THEN ratResultData.sign _ less ELSE ratResultData.sign _ greater; RETURN[ratResult]; }; firstGCD _ BC.BigGCD[ firstData.num, secondData.den ]; -- general case [cofactor1, dummy] _ BC.BigDivMod[ firstData.num, firstGCD]; [cofactor2, dummy] _ BC.BigDivMod[ secondData.den, firstGCD]; secondGCD _ BC.BigGCD[ secondData.num, firstData.den ]; [cofactor3, dummy] _ BC.BigDivMod[ secondData.num, secondGCD]; [cofactor4, dummy] _ BC.BigDivMod[ firstData.den, secondGCD]; ratResultData.num _ BC.BigMultiply[ cofactor1, cofactor3 ]; ratResultData.den _ BC.BigMultiply[ cofactor2, cofactor4 ]; IF firstData.sign # secondData.sign THEN ratResultData.sign _ less ELSE ratResultData.sign _ greater; RETURN[ratResult]; }; ObjectAndIntDesired: PUBLIC AC.UnaryToListOp ~ { RETURN[ LIST[arg, Ints.Ints] ]; -- arg assumed to be a Structure }; Power: PUBLIC AC.BinaryOp ~ { -- this simple algorithm is Structure independent power: INT _ Ints.ToINT[secondArg]; structure: Object _ firstArg.class; one: Object _ AC.ApplyLkpNoRecastObject[$one, structure, LIST[structure] ]; productMethod: Method _ AC.LookupMethodInStructure[$product, structure]; IF power < 0 THEN { invertMethod: Method _ AC.LookupMethodInStructure[$invert, structure]; temp: Object; IF invertMethod = NIL THEN ERROR; temp _ Power[firstArg, Ints.FromINT[ABS[power] ] ]; RETURN[AC.ApplyNoLkpNoRecastObject[invertMethod, LIST[temp] ] ]; }; IF power = 0 THEN RETURN[one]; result _ firstArg; FOR i:INT IN [2..power] DO result _ AC.ApplyNoLkpNoRecastObject[productMethod, LIST[firstArg, result] ]; ENDLOOP; }; Invert: PUBLIC AC.UnaryOp~ { <> <> argData: BigRatData _ NARROW[arg.data]; ratResult: BigRat _ Template[]; ratResultData: BigRatData _ NARROW[ratResult.data]; IF argData.sign = equal THEN ERROR BigRatsError[$DivideByZero]; ratResultData.sign _ argData.sign; ratResultData.num _ BC.BigCopy[ argData.den ]; ratResultData.den _ BC.BigCopy[ argData.num ]; RETURN[ratResult]; }; Divide: PUBLIC AC.BinaryOp ~ { <> firstData: BigRatData _ NARROW[firstArg.data]; IF firstData.sign = equal THEN RETURN[ firstArg ] ELSE RETURN[ Multiply[ firstArg, Invert[secondArg] ] ]; }; Paren: PUBLIC AC.UnaryOp ~ { RETURN[NEW[AC.ObjectRec _ [ flavor: StructureElement, class: BigRats, data: arg.data ] ] ]; }; <> <> <<};>> <<>> <> <> < less, equal => equal, less => greater, ENDCASE => ERROR;>> <> <<};>> <<>> <> <> <<};>> <<>> <> <> <<};>> <<>> <> <> < RETURN [RatZero];>> < RETURN [x];>> < RETURN [y];>> < {>> <> <> <> <> <> <> <> <<}>> <> <> <<[xn, yd] _ SimplifyPair[xn, yd];>> <<[yn, xd] _ SimplifyPair[yn, xd];>> <<};>> <> <> <> <> <<]];>> <<};>> <<};>> <<>> <> <> <<};>> <<>> <> <> < ERROR RuntimeError.ZeroDivisor;>> < RETURN [RatZero];>> < RETURN [x];>> < RETURN [Invert[y]];>> < {>> <> <> <> <> <> <> <> <<}>> <> <> <<[xn, yd] _ SimplifyPair[xn, yd];>> <<[yn, xd] _ SimplifyPair[yn, xd];>> <<};>> <> <> <> <> <<]];>> <<};>> <<};>> <> Equal: PUBLIC AC.BinaryPredicate = { firstData: BigRatData _ NARROW[firstArg.data]; secondData: BigRatData _ NARROW[secondArg.data]; IF firstArg = secondArg THEN RETURN [TRUE]; IF firstData.sign = secondData.sign THEN SELECT BigCardinals.BigCompare[firstData.num, secondData.num] FROM equal => SELECT BigCardinals.BigCompare[firstData.den, secondData.den] FROM equal => RETURN [TRUE]; ENDCASE; ENDCASE; RETURN [FALSE]; }; Sign: PUBLIC AC.CompareToZeroOp = { argData: BigRatData _ NARROW[arg.data]; RETURN [argData.sign] }; <<>> Abs: PUBLIC AC.UnaryOp ~ { argData: BigRatData _ NARROW[arg.data]; ratResult: BigRat _ Template[]; ratResultData: BigRatData _ NARROW[ratResult.data]; ratResultData.sign _ argData.sign; IF argData.sign = less THEN ratResultData.sign _ greater; ratResultData.num _ BC.BigCopy[argData.num]; ratResultData.den _ BC.BigCopy[argData.den]; RETURN[ratResult]; }; <> <> <<};>> <<>> Compare: PUBLIC AC.BinaryCompareOp ~ { diff: BigRat _ Subtract[firstArg, secondArg]; diffData: BigRatData _ NARROW[diff.data]; RETURN[ diffData.sign]; }; <> <> <> <> < RETURN [SELECT y.sign FROM>> < greater, equal => equal, greater => less, ENDCASE => ERROR];>> < SELECT y.sign FROM>> < {>> <> <> < RETURN [less];>> < SELECT y.sign FROM>> < {};>> < RETURN [greater];>> < ERROR;>> <> <> < >> <> < {};>> < RETURN [posLess];>> <>> <> < RETURN [posGreater];>> < RETURN [equal];>> < RETURN [posLess];>> < ERROR;>> <>> <> < {};>> < RETURN [posGreater];>> < ERROR;>> <> <> <<< -2 => RETURN [posLess];>> <<> 2 => RETURN [posGreater];>> <> <> <> < RETURN [posLess];>> < RETURN [equal];>> < RETURN [posGreater];>> < ERROR;>> <<};>> <<>> Integer: PUBLIC PROC [in: BigRat] RETURNS [BOOLEAN] ~ { <> data: BigRatData _ NARROW[in.data]; RETURN[ BCE.BigOne[data.den] ]; }; <> ToTheX: PUBLIC PROC [rat: BigRat, x: INT] RETURNS [BigRat] = { ratData: BigRatData _ NARROW[rat.data]; less: BOOL _ ratData.sign = less; abs: CARD = ABS[x]; num: BigCard _ InternalBCPower[BigCardOne, ratData.num, abs]; den: BigCard _ InternalBCPower[BigCardOne, ratData.den, abs]; IF less AND Basics.LowHalf[abs] MOD 2 = 0 THEN less _ FALSE; RETURN [IF x < 0 THEN Breed[den, num, less] ELSE Breed[num, den, less]]; }; TwoToTheX: PUBLIC PROC [x: INT, less: BOOL _ FALSE] RETURNS [BigRat] = { abs: CARD _ ABS[x]; IF abs = 0 AND NOT less THEN RETURN [RatOne] ELSE { absDiv: CARDINAL _ abs / bitsPerWord; absMod: CARDINAL _ abs MOD bitsPerWord; size: CARDINAL _ absDiv + 1; accum: BigCard _ [size, NEW[BigCardinals.BigCARDRec[size]]]; FOR i: CARDINAL IN [0..absDiv) DO accum.contents[i] _ 0; ENDLOOP; accum.contents[absDiv] _ Basics.BITSHIFT[1, absMod]; IF x < 0 THEN RETURN [Breed[BigCardOne, accum, less]] ELSE RETURN [Breed[accum, BigCardOne, less]]; }; }; BCToTheX: PUBLIC PROC [bc: BigCard, x: INT, less: BOOL _ FALSE] RETURNS [BigRat] = { abs: CARD _ ABS[x]; prod: BigCard _ bc; accum: BigCard _ InternalBCPower[BigCardOne, bc, ABS[x]]; RETURN [IF x < 0 THEN Breed[BigCardOne, accum, less] ELSE Breed[accum, BigCardOne, less]]; }; <> <> <> <> <> <> <> <> <> <> <> <<[xDen, yDen] _ SimplifyPair[xDen, yDen];>> <> <> <> <> <> <<};>> <> <> <> < {t: BigCard _ num1; num1 _ num2; num2 _ t; negate _ NOT negate};>> < {};>> < RETURN [RatZero];>> <> <> <<};>> <<>> <> < 1 OR y.size > 1 DO>> <> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <<};>> <<>> Simplify: PROC [rat: BigRat] RETURNS [BigRat] = { x: BigCard; y: BigCard; data: BigRatData _ NARROW[rat.data]; [x, y] _ SimplifyPair[data.num, data.den]; IF data.num = x THEN RETURN [rat]; RETURN [Breed[x, y, data.sign = less]]; }; tryShift: BOOL _ TRUE; tryShift2: BOOL _ TRUE; SimplifyPair: PROC [num, den: BigCard] RETURNS [BigCard, BigCard] = { x: BigCard _ num; y: BigCard _ den; wc: NAT _ 0; bits: NAT _ 0; IF x.size = 0 THEN RETURN [x, y]; IF x.size = 1 AND x.contents[0] = 1 THEN RETURN [x, y]; IF y.size = 1 AND y.contents[0] = 1 THEN RETURN [x, y]; IF tryShift THEN { <> FOR i: NAT IN [0..MIN[x.size, y.size]) DO xi: CARDINAL _ x.contents[i]; yi: CARDINAL _ y.contents[i]; bits _ 0; IF xi = 0 AND yi = 0 THEN wc _ wc + 1 ELSE { DO IF xi MOD 2 = 1 OR yi MOD 2 = 1 THEN EXIT; xi _ xi / 2; yi _ yi / 2; bits _ bits + 1; ENDLOOP; EXIT; }; ENDLOOP; IF wc # 0 OR bits # 0 THEN { x _ num _ ShiftRight[x, wc, bits]; y _ den _ ShiftRight[y, wc, bits]; }; }; DO IF tryShift2 THEN { <> x _ RightJustify[x]; y _ RightJustify[y]; }; IF x.size = 1 AND y.size = 1 THEN { <> xc: CARDINAL _ x.contents[0]; yc: CARDINAL _ y.contents[0]; DO r: CARDINAL _ xc MOD yc; IF r = 0 THEN { IF yc # 1 THEN { gcd: BigCard _ BigCardinals.BigFromSmall[yc]; x _ BigCardinals.BigDivMod[num, gcd, FALSE].quo; y _ BigCardinals.BigDivMod[den, gcd, FALSE].quo; } ELSE { x _ num; y _ den; }; RETURN [x, y]; }; xc _ yc; yc _ r; ENDLOOP; } ELSE { r: BigCard; Process.CheckForAbort[]; r _ BigCardinals.BigDivMod[x, y].rem; IF r.size = 0 THEN { <> RETURN [ BigCardinals.BigDivMod[num, y, FALSE].quo, BigCardinals.BigDivMod[den, y, FALSE].quo ]; }; x _ y; y _ r; }; ENDLOOP; }; Breed: PROC [num, den: BigCard, negate: BOOL _ FALSE] RETURNS [BigRat] = { IF den.size = 0 THEN ERROR RuntimeError.ZeroDivisor; IF num.size = 0 THEN RETURN [RatZero]; Process.CheckForAbort[]; IF den.size = 1 AND den.contents[0] = 1 THEN IF num.size = 1 AND num.contents[0] = 1 AND NOT negate THEN RETURN [RatOne]; RETURN [NEW[AC.ObjectRec _ [class: BigRats, flavor: StructureElement, data: NEW[BigRatDataRec _ [sign: IF negate THEN less ELSE greater, num: num, den: den]]]]]; }; InternalBCPower: PUBLIC PROC [bc: BigCard, base: BigCard, x: CARD] RETURNS [BigCard] = { prod: BigCard _ base; SELECT TRUE FROM bc.size = 0 => RETURN [BigCardZero]; x = 0 => RETURN [bc]; base.size = 0 => RETURN [BigCardZero]; ENDCASE => DO IF Basics.LowHalf[x] MOD 2 = 1 THEN bc _ LocalBCMultiply[bc, prod]; x _ Basics.DoubleShiftRight[[lc[x]], 1].lc; IF x = 0 THEN EXIT; prod _ LocalBCMultiply[prod, prod]; ENDLOOP; RETURN [bc]; }; RightJustify: PROC [bc: BigCard] RETURNS [BigCard] = { wc: NAT _ 0; bits: NAT _ 0; FOR i: NAT IN [0..bc.size) DO xi: CARDINAL _ bc.contents[i]; bits _ 0; IF xi = 0 THEN wc _ wc + 1 ELSE { DO IF xi MOD 2 = 1 THEN EXIT; xi _ xi / 2; bits _ bits + 1; ENDLOOP; EXIT; }; ENDLOOP; IF wc # 0 OR bits # 0 THEN { RETURN[ShiftRight[bc, wc, bits]]; }; RETURN [bc]; }; ShiftRight: PROC [bc: BigCard, words: NAT, bits: INTEGER] RETURNS [BigCard] = { size: NAT _ bc.size-words; IF size # 0 THEN TRUSTED { new: BigCard _ [size, NEW[BigCardinals.BigCARDRec[size]]]; PrincOpsUtils.LongCopy[from: @bc.contents[words], nwords: size, to: @new.contents[0] ]; IF bits # 0 THEN { FOR i: NAT IN [1..size) DO c0: CARDINAL _ new.contents[i-1]; c1: CARDINAL _ new.contents[i]; new.contents[i-1] _ Basics.BITOR[Basics.BITSHIFT[c0, -bits], Basics.BITSHIFT[c1, bitsPerWord-bits]]; ENDLOOP; IF (new.contents[size-1] _ Basics.BITSHIFT[new.contents[size-1], -bits]) = 0 THEN new.size _ size - 1; }; RETURN [new]; }; RETURN [BigCardZero]; }; LocalBCMultiply: PROC [x, y: BigCard] RETURNS [BigCard] = { xs: CARDINAL = x.size; ys: CARDINAL = y.size; xc: CARDINAL; yc: CARDINAL; SELECT TRUE FROM xs = 0, ys = 0 => RETURN [BigCardZero]; xs = 1 AND (xc _ x.contents[0]) = 1 => RETURN [y]; ys = 1 AND (yc _ y.contents[0]) = 1 => RETURN [x]; xs = 1 AND ys = 1 => RETURN [BCE.LCToBC[Basics.LongMult[xc, yc]]]; ENDCASE => RETURN [BigCardinals.BigMultiply[x, y]]; }; <> BigRatsDesired: PUBLIC AC.UnaryToListOp ~ { <> RETURN[ LIST[BigRats] ]; }; <> <> <> <> <> <> <> <> <> <<] ];>> <<>> <> <> <> <<] ];>> bigRatsClass: Object _ AC.MakeClass["bigRatsClass", NIL, NIL]; BigRats: PUBLIC Object _ AC.MakeStructure["BigRats", bigRatsClass, NIL]; BigCardZero: BigCard = BigCardinals.BigFromSmall[0]; -- do after BigRats set BigCardOne: BigCard = BigCardinals.BigFromSmall[1]; BigCardTwo: BigCard = BigCardinals.BigFromSmall[2]; BigCardTen: BigCard = BigCardinals.BigFromSmall[10]; RatZero: BigRat = NEW[AC.ObjectRec _ [class: BigRats, flavor: StructureElement, data: NEW[BigRatDataRec _ [sign: equal, num: BigCardZero, den: BigCardOne]]]]; -- do after BigRats set so structure field gets nonNIL Value RatOne: BigRat = NEW[AC.ObjectRec _ [class: BigRats, flavor: StructureElement, data: NEW[BigRatDataRec _ [sign: greater, num: BigCardOne, den: BigCardOne]]]]; -- call to FromBC would be circular RatTwo: BigRat = FromBC[BigCardTwo]; RatHalf: BigRat = Breed[BigCardOne, BigCardTwo, FALSE]; categoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ field], NIL, "category"]; groundStructureMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "groundStructure"]; shortPrintNameMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ShortPrintName], NIL, "shortPrintName"]; recastMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Recast], NIL, "recast"]; canRecastMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ CanRecast], NIL, "canRecast"]; legalFirstCharMethod: Method _ AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp _ LegalFirstChar], NIL, "legalFirstChar"]; readMethod: Method _ AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp _ Read], NIL, "read"]; fromRopeMethod: Method _ AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp _ FromRope], NIL, "fromRope"]; toRopeMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ToRope], NIL, "toRope"]; toExprMethod: Method _ AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp _ ToExpr], NEW[AC.UnaryToListOp _ BigRatsDesired], "toExpr"]; zeroMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ Zero], NIL, "zero"]; oneMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ One], NIL, "one"]; parenMethod: Method _ AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp _ Paren], NIL, "paren"]; sumMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Add], NEW[AC.UnaryToListOp _ BigRatsDesired], "sum"]; negationMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Negate], NEW[AC.UnaryToListOp _ BigRatsDesired], "negation"]; differenceMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Subtract], NEW[AC.UnaryToListOp _ BigRatsDesired], "difference"]; productMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Multiply], NEW[AC.UnaryToListOp _ BigRatsDesired], "product"]; commutativeMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "commutative"]; powerMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Power], NEW[AC.UnaryToListOp _ ObjectAndIntDesired], "power"]; invertMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Invert], NEW[AC.UnaryToListOp _ BigRatsDesired], "invert"]; fractionMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Divide], NEW[AC.UnaryToListOp _ BigRatsDesired], "fraction"]; equalMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ Equal], NEW[AC.UnaryToListOp _ BigRatsDesired], "equals"]; orderedMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "ordered"]; signMethod: Method _ AC.MakeMethod[CompareToZeroOp, TRUE, NEW[AC.CompareToZeroOp _ Sign], NEW[AC.UnaryToListOp _ BigRatsDesired], "sign"]; absMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Abs], NEW[AC.UnaryToListOp _ BigRatsDesired], "abs"]; compareMethod: Method _ AC.MakeMethod[BinaryCompareOp, TRUE, NEW[AC.BinaryCompareOp _ Compare], NEW[AC.UnaryToListOp _ BigRatsDesired], "compare"]; AC.AddMethodToClass[$category, categoryMethod, bigRatsClass]; AC.AddMethodToClass[$groundStructure, categoryMethod, bigRatsClass]; AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, bigRatsClass]; AC.AddMethodToClass[$recast, recastMethod, bigRatsClass]; AC.AddMethodToClass[$canRecast, canRecastMethod, bigRatsClass]; AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, bigRatsClass]; AC.AddMethodToClass[$read, readMethod, bigRatsClass]; AC.AddMethodToClass[$fromRope, fromRopeMethod, bigRatsClass]; AC.AddMethodToClass[$toRope, toRopeMethod, bigRatsClass]; AC.AddMethodToClass[$toExpr, toExprMethod, bigRatsClass]; AC.AddMethodToClass[$zero, zeroMethod, bigRatsClass]; AC.AddMethodToClass[$one, oneMethod, bigRatsClass]; AC.AddMethodToClass[$paren, parenMethod, bigRatsClass]; AC.AddMethodToClass[$sum, sumMethod, bigRatsClass]; AC.AddMethodToClass[$negation, negationMethod, bigRatsClass]; AC.AddMethodToClass[$difference, differenceMethod, bigRatsClass]; AC.AddMethodToClass[$product, productMethod, bigRatsClass]; AC.AddMethodToClass[$commutative, commutativeMethod, bigRatsClass]; AC.AddMethodToClass[$pow, powerMethod, bigRatsClass]; AC.AddMethodToClass[$invert, invertMethod, bigRatsClass]; AC.AddMethodToClass[$fraction, fractionMethod, bigRatsClass]; AC.AddMethodToClass[$eqFormula, equalMethod, bigRatsClass]; AC.AddMethodToClass[$ordered, orderedMethod, bigRatsClass]; AC.AddMethodToClass[$sign, signMethod, bigRatsClass]; AC.AddMethodToClass[$abs, absMethod, bigRatsClass]; AC.AddMethodToClass[$compare, compareMethod, bigRatsClass]; AC.InstallStructure[BigRats]; AC.SetSuperClass[Ints.Ints, BigRats]; END.