<> <> <> <> DIRECTORY Basics USING [LongMult], IPReal USING [Rational, ShortRational], Real USING [Fix, RealException], RealFns USING [AlmostEqual], RuntimeError USING [BoundsFault] ; IPRealImpl: CEDAR PROGRAM IMPORTS Basics, Real, RealFns, RuntimeError EXPORTS IPReal ~ BEGIN Fix: PRIVATE PROC[r: REAL] RETURNS[INT] ~ { RETURN[Real.Fix[r]] }; < GOTO Fail];>> Floor: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { c _ Fix[a ! Real.RealException => { c _ a; CONTINUE }]; IF c>a THEN RETURN[c-1] ELSE RETURN[c] }; Ceiling: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { c _ Fix[a ! Real.RealException => { c _ a; CONTINUE }]; IF c { c _ a; CONTINUE }]; RETURN[c] }; Round: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { RETURN[Floor[a + 0.5]] }; Mod: PUBLIC PROC[a, b: REAL] RETURNS[REAL] ~ { RETURN[a - b*Floor[a/b]] }; Rem: PUBLIC PROC[a, b: REAL] RETURNS[REAL] ~ { RETURN[a - b*Trunc[a/b]] }; Inverse: PROC [real: REAL] RETURNS [REAL] ~ {RETURN [1.0/real]}; <> FloorN: PROC [real: REAL] RETURNS [NAT] ~ {RETURN [Real.Fix[real]]}; <> <> ShortRationalFromReal: PUBLIC PROC [real: REAL] RETURNS [ans: IPReal.ShortRational] ~ { abs: REAL ~ ABS[real]; p: NAT _ 1; q: CARDINAL _ 0; BEGIN ENABLE Real.RealException, RuntimeError.BoundsFault => GOTO Done; f: NAT _ FloorN[abs]; r: REAL _ abs-f; pp: NAT _ p; qq: CARDINAL _ q; p _ f; q _ 1; WHILE r # 0 DO rinv: REAL _ Inverse[r]; fnew: NAT _ FloorN[rinv]; pnew: LONG CARDINAL _ Basics.LongMult[fnew, p] + pp; qnew: LONG CARDINAL _ Basics.LongMult[fnew, q] + qq; IF pnew > NAT.LAST OR qnew > CARDINAL.LAST THEN EXIT; pp _ p; qq _ q; p _ pnew; q _ qnew; r _ rinv - fnew; ENDLOOP; EXITS Done => NULL; END; ans.numerator _ p; ans.denominator _ q; IF real < 0 THEN ans.numerator _ -ans.numerator; }; mantissaBits: INTEGER _ MantissaBits[]; MantissaBits: PROC RETURNS [n: INTEGER] ~ { f: REAL _ 0.5; n _ 0; WHILE 1.0 - f # 1.0 DO f _ f/2; n _ n + 1; ENDLOOP; }; bigInt: INT _ Real.Fix[REAL[LAST[INT]/256*256]]; -- Fix of largest real that can be fixed. RationalFromReal: PUBLIC PROC [real: REAL] RETURNS [ans: IPReal.Rational] ~ { abs: REAL ~ ABS[real]; p: REAL _ 1; q: REAL _ 0; BEGIN ENABLE Real.RealException, RuntimeError.BoundsFault => GOTO Done; f: REAL _ Trunc[abs]; r: REAL _ abs-f; pp: REAL _ p; qq: REAL _ q; p _ f; q _ 1; UNTIL RealFns.AlmostEqual[p, abs*q, 3-mantissaBits] DO rinv: REAL _ Inverse[r]; fnew: REAL _ Trunc[rinv]; pnew: REAL _ fnew*p + pp; qnew: REAL _ fnew*q + qq; IF pnew > bigInt OR qnew > bigInt THEN EXIT; pp _ p; qq _ q; p _ pnew; q _ qnew; r _ rinv - fnew; ENDLOOP; EXITS Done => NULL; END; ans.numerator _ Real.Fix[p]; ans.denominator _ Real.Fix[q]; IF real < 0 THEN ans.numerator _ -ans.numerator; }; END.