PSMathImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, March 27, 1987 4:38:52 pm PST
PostScript implementation: arithmetic, math, boolean operators.
DIRECTORY
PS,
Basics USING [DoubleAnd, DoubleNot, DoubleOr, DoubleShift, DoubleXor],
Random USING [Create, NextInt],
Real USING [Ceiling, Fix, Floor, RealException],
RealFns USING [ArcTanDeg, CosDeg, Ln, Log, Power, SinDeg, SqRt];
PSMathImpl: CEDAR PROGRAM
IMPORTS Basics, PS, Random, Real, RealFns
~ BEGIN OPEN PS;
Arithmetic and math operators
Add: PROC [num1, num2: Num] RETURNS [Num] ~ {
WITH n1: num1 SELECT FROM
int => WITH n2: num2 SELECT FROM
int => {
int1: INT ~ n1.int;
int2: INT ~ n2.int;
int3: INT ~ int1+int2;
IF (int1<0)#(int2<0) OR (int2<0)=(int3<0) THEN RETURN [[int[int3]]]
ELSE RETURN [[real[REAL[int1]+REAL[int2]]]];
};
real => RETURN [[real[REAL[n1.int]+n2.real]]];
ENDCASE;
real => WITH n2: num2 SELECT FROM
int => RETURN [[real[n1.real+REAL[n2.int]]]];
real => RETURN [[real[n1.real+n2.real]]];
ENDCASE;
ENDCASE;
ERROR;
};
Sub: PROC [num1, num2: Num] RETURNS [Num] ~ {
WITH n1: num1 SELECT FROM
int => WITH n2: num2 SELECT FROM
int => {
int1: INT ~ n1.int;
int2: INT ~ n2.int;
int3: INT ~ int1-int2;
IF (int1<0)=(int2<0) OR (int2<0)#(int3<0) THEN RETURN [[int[int3]]]
ELSE RETURN [[real[REAL[int1]-REAL[int2]]]];
};
real => RETURN [[real[REAL[n1.int]-n2.real]]];
ENDCASE;
real => WITH n2: num2 SELECT FROM
int => RETURN [[real[n1.real-REAL[n2.int]]]];
real => RETURN [[real[n1.real-n2.real]]];
ENDCASE;
ENDCASE;
ERROR;
};
Mul: PROC [num1, num2: Num] RETURNS [Num] ~ {
WITH n1: num1 SELECT FROM
int => WITH n2: num2 SELECT FROM
int => {
int1: INT ~ n1.int;
int2: INT ~ n2.int;
int3: INT ~ int1*int2;
real3: REAL ~ REAL[int1]*REAL[int2];
********** fix this **********
IF int3=real3 THEN RETURN [[int[int3]]]
ELSE RETURN [[real[REAL[int1]*REAL[int2]]]];
};
real => RETURN [[real[REAL[n1.int]*n2.real]]];
ENDCASE;
real => WITH n2: num2 SELECT FROM
int => RETURN [[real[n1.real*REAL[n2.int]]]];
real => RETURN [[real[n1.real*n2.real]]];
ENDCASE;
ENDCASE;
ERROR;
};
Abs: PROC [num: Num] RETURNS [Num] ~ {
WITH n: num SELECT FROM
int => {
IF n.int#INT.FIRST THEN RETURN [[int[ABS[n.int]]]]
ELSE RETURN [[real[ABS[REAL[n.int]]]]];
};
real => RETURN [[real[ABS[n.real]]]];
ENDCASE;
ERROR;
};
Neg: PROC [num: Num] RETURNS [Num] ~ {
WITH n: num SELECT FROM
int => {
IF n.int#INT.FIRST THEN RETURN [[int[-n.int]]]
ELSE RETURN [[real[-REAL[n.int]]]];
};
real => RETURN [[real[-n.real]]];
ENDCASE;
ERROR;
};
Truncate: PROC [x: REAL] RETURNS [z: REAL] ~ {
z ← Real.Fix[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};
Ceiling: PROC [x: REAL] RETURNS [z: REAL] ~ {
z ← Real.Ceiling[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};
Floor: PROC [x: REAL] RETURNS [z: REAL] ~ {
z ← Real.Floor[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};
Round: PROC [x: REAL] RETURNS [REAL] ~ {
RETURN [Floor[x+0.5]];
};
Padd: PROC [self: Root] ~ {
num2: Num ~ PopNum[self];
num1: Num ~ PopNum[self];
PushNum[self, Add[num1, num2]];
};
Psub: PROC [self: Root] ~ {
num2: Num ~ PopNum[self];
num1: Num ~ PopNum[self];
PushNum[self, Sub[num1, num2]];
};
Pmul: PROC [self: Root] ~ {
num2: Num ~ PopNum[self];
num1: Num ~ PopNum[self];
PushNum[self, Mul[num1, num2]];
};
Pdiv: PROC [self: Root] ~ {
n2: REAL ~ PopReal[self];
n1: REAL ~ PopReal[self];
PushReal[self, n1/n2];
};
Pidiv: PROC [self: Root] ~ {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, int1/int2];
};
Pmod: PROC [self: Root] ~ {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, int1 MOD int2];
};
Pabs: PROC [self: Root] ~ {
num: Num ~ PopNum[self];
PushNum[self, Abs[num]];
};
Pneg: PROC [self: Root] ~ {
num: Num ~ PopNum[self];
PushNum[self, Neg[num]];
};
Pceiling: PROC [self: Root] ~ {
SELECT TopType[self] FROM
integer => NULL;
real => PushReal[self, Ceiling[PopReal[self]]];
ENDCASE => ERROR Error[typecheck];
};
Pfloor: PROC [self: Root] ~ {
SELECT TopType[self] FROM
integer => NULL;
real => PushReal[self, Floor[PopReal[self]]];
ENDCASE => ERROR Error[typecheck];
};
Pround: PROC [self: Root] ~ {
SELECT TopType[self] FROM
integer => NULL;
real => PushReal[self, Round[PopReal[self]]];
ENDCASE => ERROR Error[typecheck];
};
Ptruncate: PROC [self: Root] ~ {
SELECT TopType[self] FROM
integer => NULL;
real => PushReal[self, Truncate[PopReal[self]]];
ENDCASE => ERROR Error[typecheck];
};
Psqrt: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.SqRt[num]];
};
Patan: PROC [self: Root] ~ {
den: REAL ~ PopReal[self];
num: REAL ~ PopReal[self];
PushReal[self, RealFns.ArcTanDeg[num, den]];
};
Pcos: PROC [self: Root] ~ {
angle: REAL ~ PopReal[self];
PushReal[self, RealFns.CosDeg[angle]];
};
Psin: PROC [self: Root] ~ {
angle: REAL ~ PopReal[self];
PushReal[self, RealFns.SinDeg[angle]];
};
Pexp: PROC [self: Root] ~ {
exponent: REAL ~ PopReal[self];
base: REAL ~ PopReal[self];
PushReal[self, RealFns.Power[base, exponent]];
};
Pln: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.Ln[num]];
};
Plog: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.Log[10, num]];
};
Prand: PROC [self: Root] ~ {
int: INT ~ Random.NextInt[self.random];
PushInt[self, int];
};
Psrand: PROC [self: Root] ~ {
int: INT ~ PopInt[self];
self.random ← Random.Create[seed: int];
};
Prrand: PROC [self: Root] ~ {
ERROR Error[unimplemented];
};
Boolean and bitwise operators
Pand: PROC [self: Root] ~ {
SELECT TopType[self] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 AND bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleAnd[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
Pnot: PROC [self: Root] ~ {
SELECT TopType[self] FROM
boolean => {
bool1: BOOL ~ PopBool[self];
PushBool[self, NOT bool1];
};
integer => {
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleNot[[li[int1]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
Por: PROC [self: Root] ~ {
SELECT TopType[self] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 OR bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleOr[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
Pxor: PROC [self: Root] ~ {
SELECT TopType[self] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 # bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleXor[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
Pbitshift: PROC [self: Root] ~ {
shift: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
IF shift NOT IN INTEGER THEN PushInt[self, 0]
ELSE PushInt[self, Basics.DoubleShift[[li[int1]], shift].li];
};
Registered primitives
true: Any ~ AnyFromBool[TRUE];
false: Any ~ AnyFromBool[FALSE];
MathPrimitives: PROC [self: Root] ~ {
Register[self, "add", Padd];
Register[self, "div", Pdiv];
Register[self, "idiv", Pidiv];
Register[self, "mod", Pmod];
Register[self, "mul", Pmul];
Register[self, "sub", Psub];
Register[self, "abs", Pabs];
Register[self, "neg", Pneg];
Register[self, "ceiling", Pceiling];
Register[self, "floor", Pfloor];
Register[self, "round", Pround];
Register[self, "truncate", Ptruncate];
Register[self, "sqrt", Psqrt];
Register[self, "atan", Patan];
Register[self, "cos", Pcos];
Register[self, "sin", Psin];
Register[self, "exp", Pexp];
Register[self, "ln", Pln];
Register[self, "log", Plog];
Register[self, "rand", Prand];
Register[self, "srand", Psrand];
Register[self, "rrand", Prrand];
Register[self, "and", Pand];
Register[self, "not", Pnot];
Register[self, "or", Por];
Register[self, "xor", Pxor];
Register[self, "bitshift", Pbitshift];
RegisterVal[self, "true", true];
RegisterVal[self, "false", false];
};
RegisterPrimitives[MathPrimitives];
END.