MispNumbers.Mesa
Last Edited by: Spreitzer, June 18, 1985 5:43:00 pm PDT
Pavel, June 19, 1985 4:38:19 pm PDT
DIRECTORY Complex, IO, List, Misp, Real, RealFns, Rope, Vector;
MispNumbers:
CEDAR
PROGRAM
IMPORTS Complex, IO, RealDefs: Real, RealFns, Misp, Vector
EXPORTS Misp =
BEGIN OPEN Misp;
DefineNumberStuff: EnvironmentProc =
BEGIN
Defun[environment, $complex, EvalComplex];
Defun[environment, $re, EvalRe];
Defun[environment, $im, EvalIm];
Defun[environment, $reim, EvalReIm];
Defun[environment, $round, EvalRound];
Defun[environment, $floor, EvalFloor];
Defun[environment, $ceiling, EvalCeiling];
Defun[environment, $abs, EvalAbs];
Defun[environment, $sgn, EvalSgn];
Defun[environment, $arg, EvalArg];
Defun[environment, $exp, EvalExp];
Defun[environment, $ln, EvalLn];
Defun[environment, $sin, EvalSin];
Defun[environment, $cos, EvalCos];
Defun[environment, $tan, EvalTan];
Defun[environment, $gcd, EvalGcd];
Defun[environment, $lcm, EvalLcm];
DefIntRealArith[environment, $plus, PlusInts, PlusReals, PlusCxs, 0];
DefIntRealArith[environment, $minus, MinusInts, MinusReals, MinusCxs, 0];
DefIntRealArith[environment, $mult, MultInts, MultReals, MultCxs, 1];
DefIntRealArith[environment, $div, DivInts, DivReals, DivCxs, 1];
DefIntRealArith[environment, $quot, QuotInts, QuotReals, QuotCxs, 1];
DefIntRealArith[environment, $rem, RemInts, RemReals, RemCxs, 1];
DefIntRealArith[environment, $min, MinInts, MinReals, MinCxs, 2000000000];
DefIntRealArith[environment, $max, MaxInts, MaxReals, MaxCxs, -2000000000];
DefIntRealCond[environment, $lt, LtInts, LtReals];
DefIntRealCond[environment, $le, LeInts, LeReals];
DefIntRealCond[environment, $gt, GtInts, GtReals];
DefIntRealCond[environment, $ge, GeInts, GeReals];
END;
DefIntRealArith:
PROC [environment: Environment, name:
ATOM, Ints: IntArithProc, Reals: RealArithProc, Comps: ComplexArithProc, identity:
INT, leftToRight:
BOOLEAN ←
TRUE] =
BEGIN
Defun[env: environment, name: name, eval: EvalIntRealArith, data: NEW [IntRealArithRep ← [Ints: Ints, Reals: Reals, Comps: Comps, identity: identity, leftToRight: leftToRight]]];
END;
DefIntRealCond:
PROC [environment: Environment, name:
ATOM, Ints: IntCondProc, Reals: RealCondProc] =
BEGIN
Defun[env: environment, name: name, eval: EvalIntRealCond, data: NEW [IntRealCondRep ← [Ints: Ints, Reals: Reals]]];
END;
PickReal:
PROC [args:
LORA, environment: Environment, stack: Stack]
RETURNS [r:
REAL, rest:
LORA] = {
WITH args.first
SELECT
FROM
real: Real => r ← real^;
int: Int => r ← int^;
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[args.first]]];
rest ← args.rest};
EvalComplex: EvalProc =
BEGIN
rest: LORA;
r, i: REAL;
[r, rest] ← PickReal[args, environment, stack];
[i, ] ← PickReal[rest, environment, stack];
cooked ← NEW [COMPLEX ← [r, i]];
END;
EvalRe: EvalProc =
BEGIN
c: Comp ← NARROW[args.first];
cooked ← NEW [REAL ← Re[c^]];
END;
EvalIm: EvalProc =
BEGIN
c: Comp ← NARROW[args.first];
cooked ← NEW [REAL ← Im[c^]];
END;
EvalReIm: EvalProc =
BEGIN
c: Comp ← NARROW[args.first];
cooked ← LIST [NEW [REAL ← Re[c^]], NEW [REAL ← Im[c^]]];
END;
EvalRound: EvalProc =
BEGIN
r: REAL;
[r, ] ← PickReal[args, environment, stack];
cooked ← NEW [INT ← RealDefs.RoundLI[r]];
END;
EvalFloor: EvalProc =
{x: REAL;
[x, ] ← PickReal[args, environment, stack];
cooked ← NEW [INT ← Floor[x]]};
EvalCeiling: EvalProc =
{x: REAL;
[x, ] ← PickReal[args, environment, stack];
cooked ← NEW [INT ← Ceiling[x]]};
Floor:
PROC [x:
REAL]
RETURNS [f:
INT] =
BEGIN
d: INT ← 1 - RealDefs.Fix[x];
f ← RealDefs.Fix[x+d]-d;
END;
Ceiling:
PROC [x:
REAL]
RETURNS [f:
INT] =
BEGIN
d: INT ← 1 + RealDefs.Fix[x];
f ← RealDefs.Fix[x-d]+d;
END;
EvalSin: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [REAL ← RealFns.Sin[i^]];
r: Real => cooked ← NEW [REAL ← RealFns.Sin[r^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalCos: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [REAL ← RealFns.Cos[i^]];
r: Real => cooked ← NEW [REAL ← RealFns.Cos[r^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalTan: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [REAL ← RealFns.Tan[i^]];
r: Real => cooked ← NEW [REAL ← RealFns.Tan[r^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first], IO.refAny[environment]]];
END;
ToInt:
PUBLIC
PROC [ra:
REF
ANY, environment: Environment, stack: Stack]
RETURNS [i:
INT] = {
WITH ra
SELECT
FROM
ri: Int => RETURN[ri^];
rr: Real => {i ← RealDefs.RoundLI[rr^]; IF rr^ = i THEN RETURN};
c: Comp => {i ← RealDefs.RoundLI[Re[c^]]; IF Im[c^] = 0 AND Re[c^] = i THEN RETURN};
ENDCASE;
ERROR Error[environment, stack, IO.PutFR["%g not an integer, in %g", IO.refAny[ra], IO.refAny[environment]]];
};
ToReal:
PUBLIC
PROC [ra:
REF
ANY, environment: Environment, stack: Stack]
RETURNS [r:
REAL] = {
WITH ra
SELECT
FROM
ri: Int => RETURN[ri^];
rr: Real => RETURN[rr^];
c: Comp => IF Im[c^] = 0 THEN RETURN[Re[c^]];
ENDCASE;
ERROR Error[environment, stack, IO.PutFR["%g not a real, in %g", IO.refAny[ra], IO.refAny[environment]]];
};
ToComplex:
PUBLIC
PROC [ra:
REF
ANY, environment: Environment, stack: Stack]
RETURNS [c:
COMPLEX] = {
WITH ra
SELECT
FROM
ri: Int => RETURN[[ri^, 0]];
rr: Real => RETURN[[rr^, 0]];
c: Comp => RETURN[c^];
ENDCASE;
};
EvalGcd: EvalProc =
BEGIN
ans: INT ← 1;
first: BOOL ← TRUE;
FOR args ← args, args.rest
WHILE args #
NIL
DO
i: INT ← ToInt[args.first, environment, stack];
IF first THEN {ans ← i; first ← FALSE} ELSE ans ← Gcd[ans, i];
ENDLOOP;
cooked ← NEW [INT ← ans];
END;
Gcd:
PROC [a, b:
INT]
RETURNS [gcd:
INT] = {
gcd ← SGNI[a] * SGNI[b];
a ← ABS[a];
b ← ABS[b];
DO
SELECT
TRUE
FROM
a = 0 => RETURN [b*gcd];
b = 0 => RETURN [a*gcd];
a = b => RETURN [a*gcd];
a < b => b ← b MOD a;
a > b => a ← a MOD b;
ENDCASE => ERROR;
ENDLOOP;
};
Lcm:
PROC [a, b:
INT]
RETURNS [gcd:
INT] = {
gcd ← IF a # 0 OR b # 0 THEN (a/Gcd[a, b])*b ELSE 0;
};
EvalLcm: EvalProc =
BEGIN
ans: INT ← 1;
FOR args ← args, args.rest
WHILE args #
NIL
DO
i: INT ← ToInt[args.first, environment, stack];
ans ← Lcm[ans, i];
ENDLOOP;
cooked ← NEW [INT ← ans];
END;
EvalExp: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [REAL ← RealFns.Exp[i^]];
r: Real => cooked ← NEW [REAL ← RealFns.Exp[r^]];
c: Comp => cooked ← NEW [COMPLEX ← Complex.Exp[c^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalLn: EvalProc =
BEGIN
RiaLynn:
PROC [r:
REAL]
RETURNS [ln:
REF
ANY] =
{ln ←
IF r > 0
THEN NEW [REAL ← RealFns.Ln[r]]
ELSE NEW [COMPLEX ← Complex.Ln[[r, 0]]]};
WITH args.first
SELECT
FROM
i: Int => cooked ← RiaLynn[i^];
r: Real => cooked ← RiaLynn[r^];
c: Comp => cooked ← NEW [COMPLEX ← Complex.Ln[c^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalAbs: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [INT ← ABS[i^]];
r: Real => cooked ← NEW [REAL ← ABS[r^]];
c: Comp => cooked ← NEW [REAL ← Complex.Abs[c^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalSgn: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [INT ← SGNI[i^]];
r: Real => cooked ← NEW [INT ← SGN[r^]];
c: Comp => cooked ← NEW [COMPLEX ← Vector.Unit[c^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
EvalArg: EvalProc =
BEGIN
WITH args.first
SELECT
FROM
i: Int => cooked ← NEW [REAL ← Arg[i^]];
r: Real => cooked ← NEW [REAL ← Arg[r^]];
c: Comp => cooked ← NEW [REAL ← Complex.Arg[c^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number, in %g", IO.refAny[args.first]]];
END;
SGNI:
PROC [x:
INT]
RETURNS [s:
INT] =
{s ← IF x < 0 THEN -1 ELSE IF x > 0 THEN 1 ELSE 0};
SGN:
PROC [x:
REAL]
RETURNS [s:
INT] =
{s ← IF x < 0 THEN -1 ELSE IF x > 0 THEN 1 ELSE 0};
Arg:
PROC [x:
REAL]
RETURNS [s:
REAL] =
{s ← IF x < 0 THEN 3.141592653589793 ELSE 0};
EvalIntRealArith: EvalProc =
BEGIN
ir: IntRealArith ← NARROW[data];
IF args = NIL THEN RETURN [NEW [INT ← ir.identity]];
cooked ← args.first;
IF args.rest = NIL THEN RETURN;
IF ir.leftToRight
THEN
BEGIN
FOR args ← args.rest, args.rest
WHILE args #
NIL
DO
next: REF ANY ← args.first;
WITH cooked
SELECT
FROM
i1: Int =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [INT ← ir.Ints[i1^, i2^]];
r2: Real => cooked ← NEW [REAL ← ir.Reals[i1^, r2^]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[[i1^, 0], c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
r1: Real =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [REAL ← ir.Reals[r1^, i2^]];
r2: Real => cooked ← NEW [REAL ← ir.Reals[r1^, r2^]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[[r1^, 0], c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
c1: Comp =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [COMPLEX ← ir.Comps[c1^, [i2^, 0]]];
r2: Real => cooked ← NEW [COMPLEX ← ir.Comps[c1^, [r2^, 0]]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[c1^, c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[cooked]]];
ENDLOOP;
END
ELSE
BEGIN
next: REF ANY ← EvalIntRealArith[args.rest, environment, ir, stack];
WITH cooked
SELECT
FROM
i1: Int =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [INT ← ir.Ints[i1^, i2^]];
r2: Real => cooked ← NEW [REAL ← ir.Reals[i1^, r2^]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[[i1^, 0], c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
r1: Real =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [REAL ← ir.Reals[r1^, i2^]];
r2: Real => cooked ← NEW [REAL ← ir.Reals[r1^, r2^]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[[r1^, 0], c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
c1: Comp =>
WITH next
SELECT
FROM
i2: Int => cooked ← NEW [COMPLEX ← ir.Comps[c1^, [i2^, 0]]];
r2: Real => cooked ← NEW [COMPLEX ← ir.Comps[c1^, [r2^, 0]]];
c2: Comp => cooked ← NEW [COMPLEX ← ir.Comps[c1^, c2^]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[cooked]]];
END;
END;
IntRealArith: TYPE = REF IntRealArithRep;
IntRealArithRep:
TYPE =
RECORD [
Ints: IntArithProc, Reals: RealArithProc, Comps: ComplexArithProc, identity: INT, leftToRight: BOOLEAN];
IntArithProc: TYPE = PROCEDURE [left, right: INT] RETURNS [INT];
RealArithProc: TYPE = PROCEDURE [left, right: REAL] RETURNS [REAL];
ComplexArithProc: TYPE = PROC [left, right: COMPLEX] RETURNS [ans: COMPLEX];
PlusInts: IntArithProc = {RETURN [left+right]};
PlusReals: RealArithProc = {RETURN [left+right]};
PlusCxs: ComplexArithProc = {RETURN [Complex.Add[left, right]]};
MinusInts: IntArithProc = {RETURN [left-right]};
MinusReals: RealArithProc = {RETURN [left-right]};
MinusCxs: ComplexArithProc = {RETURN [Complex.Sub[left, right]]};
MultInts: IntArithProc = {RETURN [left*right]};
MultReals: RealArithProc = {RETURN [left*right]};
MultCxs: ComplexArithProc = {RETURN [Complex.Mul[left, right]]};
DivInts: IntArithProc = {RETURN [left/right]};
DivReals: RealArithProc = {RETURN [left/right]};
DivCxs: ComplexArithProc = {RETURN [Complex.Div[left, right]]};
QuotInts: IntArithProc = {
neg: BOOLEAN ← (left < 0) # (right < 0);
ans: INT ← left / right;
RETURN [IF neg THEN -ans ELSE ans]};
QuotReals: RealArithProc = {
RETURN [Floor[left/right]]};
QuotCxs: ComplexArithProc = {
ans ← Complex.Div[left, right];
ans ← [Floor[Re[ans]], Floor[Im[ans]]]};
RemInts: IntArithProc = {
RETURN [IF right = 0 THEN left ELSE (((left MOD right)+right) MOD right)]};
RemReals: RealArithProc = {
q: INT ← IF right = 0.0 THEN 0 ELSE Floor[left/right];
RETURN [left - right*q]};
ComplexZero: COMPLEX = [x: 0, y: 0];
RemCxs: ComplexArithProc = {
q: COMPLEX ← IF right = ComplexZero THEN ComplexZero ELSE Complex.Div[left, right];
ans ← Complex.Sub[left, Complex.Mul[[Floor[Re[q]], Floor[Im[q]]], right]]};
MinInts: IntArithProc = {RETURN [MIN[left, right]]};
MaxInts: IntArithProc = {RETURN [MAX[left, right]]};
MinReals: RealArithProc = {RETURN [MIN[left, right]]};
MaxReals: RealArithProc = {RETURN [MAX[left, right]]};
MinCxs: ComplexArithProc = {ans ← IF Re[right] < Re[left] THEN right ELSE left};
MaxCxs: ComplexArithProc = {ans ← IF Re[right] > Re[left] THEN right ELSE left};
EvalIntRealCond: EvalProc =
BEGIN
ir: IntRealCond ← NARROW[data];
ans: BOOLEAN ← TRUE;
left: REF ANY;
IF args = NIL THEN RETURN [$T];
left ← args.first;
IF args.rest = NIL THEN RETURN [$T];
FOR args ← args.rest, args.rest
WHILE args #
NIL
DO
next: REF ANY ← args.first;
WITH left
SELECT
FROM
i1: Int =>
WITH next
SELECT
FROM
i2: Int => ans ← ans AND ir.Ints[i1^, i2^];
r2: Real => ans ← ans AND ir.Reals[i1^, r2^];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
r1: Real =>
WITH next
SELECT
FROM
i2: Int => ans ← ans AND ir.Reals[r1^, i2^];
r2: Real => ans ← ans AND ir.Reals[r1^, r2^];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[next]]];
ENDCASE => ERROR Error[environment, stack, IO.PutFR["%g not a number", IO.refAny[left]]];
ENDLOOP;
cooked ← IF ans THEN $T ELSE NIL;
END;
IntRealCond: TYPE = REF IntRealCondRep;
IntRealCondRep: TYPE = RECORD [Ints: IntCondProc, Reals: RealCondProc];
IntCondProc: TYPE = PROC [left, right: INT] RETURNS [BOOLEAN];
RealCondProc: TYPE = PROC [left, right: REAL] RETURNS [BOOLEAN];
LtInts: IntCondProc = {RETURN [left < right]};
LeInts: IntCondProc = {RETURN [left <= right]};
GtInts: IntCondProc = {RETURN [left > right]};
GeInts: IntCondProc = {RETURN [left >= right]};
LtReals: RealCondProc = {RETURN [left < right]};
LeReals: RealCondProc = {RETURN [left <= right]};
GtReals: RealCondProc = {RETURN [left > right]};
GeReals: RealCondProc = {RETURN [left >= right]};
Setup:
PROC =
BEGIN
RegisterPrimitiveDefiner[DefineNumberStuff, front];
END;
Setup[];
END.