File: [Cherry]<Thyme>Cedar5.1>System>spExpressions.mesa
Last editted: June 10, 1984 4:42:56 pm PDT
DIRECTORY
Real USING [FixI, RealException, RoundLI],
RealFns USING [Exp, Ln, Power, SqRt],
spGlobals USING [error, ErrorSignal, expressionNode, expressionPtr, getParmValue, Handle, itemType, namePtr, next, putParmValue, RefParmRec, variable];
spExpressions: CEDAR PROGRAM
IMPORTS Real, RealFns, spGlobals
EXPORTS spGlobals=
BEGIN OPEN spGlobals;
factor: PROC[handle: Handle] RETURNS[f: expressionPtr]= {
OPEN handle.vars;
n: namePtr;
SELECT item FROM
leftP => {
next[handle];
f← expression[handle];
IF item=rightP THEN next[handle] ELSE error[handle, 211]
};
name => {
-- the "variable" below searchs for newString on currentCkt, all levels, to get a nPtr of
-- types RefParmRec, RefNodeRec, or RefConRec. then next[].
n← variable[handle, newString, NIL];
-- when item=name, type← real only if n=nil or n points to a parameter,
-- otherwise it gets name.
type← IF n=NIL THEN real
ELSE WITH n.details SELECT FROM
x: RefParmRec => real, ENDCASE => name;
f← NEW[load expressionNode←
[operands: load[var: n, expr: NIL]] ];
};
number => {
type← real;
f← NEW[num expressionNode← [operands: num[v: value]] ];
next[handle]
};
-- string => {
-- type← real;
-- f← NEW[num expressionNode←
-- [operands: num[v: LOOPHOLE[newString, REAL]] ] ];
-- next[handle]
-- };
ENDCASE => error[handle, 209];
}; -- factor
unaryExpr: PROC[handle: Handle] RETURNS[u: expressionPtr]= {
OPEN handle.vars;
SELECT item FROM
minus, atSign, upArrow, backSlash, slash, squiggle, vertical => {
oldItem: itemType← item;
next[handle];
u← SELECT oldItem FROM
minus => u← NEW[neg expressionNode←
[operands: neg[unaryOp: unaryExpr[handle]] ] ],
atSign => u← NEW[neg expressionNode←
[operands: abs[unaryOp: unaryExpr[handle]] ] ],
slash => u← NEW[neg expressionNode←
[operands: sqrt[unaryOp: unaryExpr[handle]] ] ],
squiggle => u← NEW[neg expressionNode←
[operands: not[unaryOp: unaryExpr[handle]] ] ],
backSlash => u← NEW[neg expressionNode←
[operands: log[unaryOp: unaryExpr[handle]] ] ],
upArrow => u← NEW[neg expressionNode←
[operands: exp[unaryOp: unaryExpr[handle]] ] ],
ENDCASE => u← NEW[neg expressionNode←
[operands: int[unaryOp: unaryExpr[handle]] ] ];
IF type > real THEN error[handle, 270];
};
ENDCASE => u← factor[handle];
}; -- unaryExpr
powerExpr: PROC[handle: Handle] RETURNS[pwr: expressionPtr]= {
OPEN handle.vars;
pwrTemp: expressionPtr;
pwr← unaryExpr[handle];
IF item=upArrow THEN {
IF type > real THEN error[handle, 270];
next[handle];
pwrTemp← NEW[power expressionNode←
[operands: power[leftOp: pwr, rightOp: unaryExpr[handle]] ] ];
IF type > real THEN error[handle, 270];
pwr← pwrTemp;
};
}; -- powerExpr
term: PROC[handle: Handle] RETURNS[trm: expressionPtr]= {
OPEN handle.vars;
mulOp: BOOL;
trmTemp: expressionPtr;
trm← powerExpr[handle];
IF item=star OR item=slash THEN
IF type > real THEN error[handle, 270];
WHILE item=star OR item=slash DO
mulOp← (item=star);
next[handle];
trmTemp← IF mulOp THEN NEW[mul expressionNode←
[operands: mul[leftOp: trm, rightOp: powerExpr[handle]] ] ]
ELSE NEW[div expressionNode←
[operands: div[leftOp: trm, rightOp: powerExpr[handle]] ] ];
IF type > real THEN error[handle, 270];
trm← trmTemp;
ENDLOOP;
}; -- term
arithExpr: PROC[handle: Handle] RETURNS[ar: expressionPtr]= {
OPEN handle.vars;
arTemp: expressionPtr;
itemSave: itemType;
ar← term[handle];
IF (item=plus OR item=minus) OR (item=maximum OR item=minimum) THEN
IF type > real THEN error[handle, 270];
WHILE (item=plus OR item=minus) OR (item=maximum OR item=minimum) DO
itemSave← item;
next[handle];
arTemp← SELECT itemSave FROM
plus => NEW[add expressionNode←
[operands: add[leftOp: ar, rightOp: term[handle]] ] ],
minus => NEW[sub expressionNode←
[operands: sub[leftOp: ar, rightOp: term[handle]] ] ],
maximum => NEW[max expressionNode←
[operands: max[leftOp: ar, rightOp: term[handle]] ] ],
ENDCASE => NEW[min expressionNode←
[operands: min[leftOp: ar, rightOp: term[handle]] ] ];
IF type > real THEN error[handle, 270];
ar← arTemp;
ENDLOOP;
}; -- arithExpr
relExpr: PROC[handle: Handle] RETURNS[r: expressionPtr]= {
OPEN handle.vars;
rTemp: expressionPtr;
nodeOK: BOOL;
r← arithExpr[handle];
SELECT item FROM
greater, less, equal, pound, greatEqual, lessEqual => {
oldItem: itemType← item;
next[handle];
nodeOK← oldItem=equal OR oldItem=pound;
IF type > real AND ~nodeOK THEN error[handle, 270];
rTemp← SELECT oldItem FROM
greater => NEW[grt expressionNode←
[operands: grt[leftOp: r, rightOp: arithExpr[handle]] ] ],
greatEqual => NEW[geq expressionNode←
[operands: geq[leftOp: r, rightOp: arithExpr[handle]] ] ],
less => NEW[les expressionNode←
[operands: les[leftOp: r, rightOp: arithExpr[handle]] ] ],
lessEqual => NEW[leq expressionNode←
[operands: leq[leftOp: r, rightOp: arithExpr[handle]] ] ],
equal => NEW[eq expressionNode←
[operands: eq[leftOp: r, rightOp: arithExpr[handle]] ] ],
ENDCASE => NEW[neq expressionNode←
[operands: neq[leftOp: r, rightOp: arithExpr[handle]] ] ];
IF type > real AND ~nodeOK THEN error[handle, 270];
type← real;
r← rTemp;
};
ENDCASE;
}; -- relExpr
andExpr: PROC[handle: Handle] RETURNS[an: expressionPtr]= {
OPEN handle.vars;
anTemp: expressionPtr;
an← relExpr[handle];
IF item=amperesand THEN
IF type > real THEN error[handle, 270];
WHILE item=amperesand DO -- & is or operator
next[handle];
anTemp← NEW[and expressionNode←
[operands: and[leftOp: an, rightOp: relExpr[handle]] ] ];
IF handle.vars.type > real THEN error[handle, 270];
an← anTemp;
ENDLOOP;
}; -- andExpr
expression: PUBLIC PROC[handle: Handle] RETURNS[o: expressionPtr]= {
OPEN handle.vars;
oTemp: expressionPtr;
o← andExpr[handle];
IF item=vertical THEN
IF type > real THEN error[handle, 270];
WHILE item=vertical DO -- | is the "or" operator
next[handle];
oTemp← NEW[or expressionNode←
[operands: or[leftOp: o, rightOp: andExpr[handle]] ] ];
IF handle.vars.type > real THEN error[handle, 270];
o← oTemp;
ENDLOOP;
}; -- expression
assignExpr: PUBLIC PROC[handle: Handle, leftContext: namePtr]
RETURNS[a: expressionPtr]= {
OPEN handle.vars;
v: namePtr← variable[handle, newString, leftContext]; -- a variable
IF v # NIL THEN WITH v.details SELECT FROM -- v must point to a parameter
x: RefParmRec => NULL;
ENDCASE => error[handle, 271];
IF item=leftArrow THEN next[handle] ELSE error[handle, 210];
a← NEW[store expressionNode←
[operands: store[var: v,
expr: expression[handle]] ] ];
IF type > real THEN error[handle, 270];
}; -- assignExpr
eval: PUBLIC PROC[handle: Handle, exp: expressionPtr] RETURNS[v: REAL]= {
ENABLE Real.RealException => {
errorCode: CARDINAL← SELECT TRUE FROM
flags[divisionByZero] => 901,
flags[overflow] => 902,
flags[underflow] => 903,
flags[fixOverflow] => 904,
ENDCASE => 900;
ErrorSignal[errorCode, "?"]
};
v← ev[handle, exp];
}; -- eval
ev: PROC[handle: Handle, exp: expressionPtr] RETURNS[v: REAL]= {
IF exp=NIL THEN RETURN[0.0];
WITH exp SELECT FROM
e: REF max expressionNode =>
v← MAX[ev[handle, e.leftOp], ev[handle, e.rightOp]];
e: REF min expressionNode =>
v← MIN[ev[handle, e.leftOp], ev[handle, e.rightOp]];
e: REF add expressionNode =>
v← ev[handle, e.leftOp] + ev[handle, e.rightOp];
e: REF sub expressionNode =>
v← ev[handle, e.leftOp] - ev[handle, e.rightOp];
e: REF mul expressionNode =>
v← ev[handle, e.leftOp] * ev[handle, e.rightOp];
e: REF div expressionNode =>
v← ev[handle, e.leftOp] / ev[handle, e.rightOp];
e: REF eq expressionNode =>
v← IF (LOOPHOLE[ev[handle, e.leftOp], LONG CARDINAL]=
LOOPHOLE[ev[handle, e.rightOp], LONG CARDINAL]) THEN 1.0 ELSE 0.0;
e: REF neq expressionNode =>
v← IF (LOOPHOLE[ev[handle, e.leftOp], LONG CARDINAL] #
LOOPHOLE[ev[handle, e.rightOp], LONG CARDINAL]) THEN 1.0 ELSE 0.0;
e: REF grt expressionNode =>
v← IF (ev[handle, e.leftOp] > ev[handle, e.rightOp]) THEN 1.0 ELSE 0.0;
e: REF les expressionNode =>
v← IF (ev[handle, e.leftOp] < ev[handle, e.rightOp]) THEN 1.0 ELSE 0.0;
e: REF geq expressionNode =>
v← IF (ev[handle, e.leftOp] >= ev[handle, e.rightOp]) THEN 1.0 ELSE 0.0;
e: REF leq expressionNode =>
v← IF (ev[handle, e.leftOp] <= ev[handle, e.rightOp]) THEN 1.0 ELSE 0.0;
e: REF and expressionNode =>
v← IF (ev[handle, e.leftOp]*ev[handle, e.rightOp] # 0.0) THEN 1.0 ELSE 0.0;
e: REF or expressionNode =>
v← IF (ev[handle, e.leftOp] # 0.0) OR (ev[handle, e.rightOp] # 0.0)
THEN 1.0 ELSE 0.0;
e: REF power expressionNode=> {
x: REAL← ev[handle, e.leftOp];
y: REAL← ev[handle, e.rightOp];
IF ABS[y] < 100.0 AND y=Real.FixI[y] THEN {
v← 1.0;
THROUGH[1..ABS[Real.FixI[y]]] DO v← v*x ENDLOOP;
IF y < 0.0 THEN v← 1.0/v
}
ELSE v← RealFns.Power[ev[handle, e.leftOp], ev[handle, e.rightOp]]
};
e: REF int expressionNode => v← Real.RoundLI[ev[handle, e.unaryOp]];
e: REF abs expressionNode => v← ABS[ev[handle, e.unaryOp]];
e: REF exp expressionNode => v← RealFns.Exp[ev[handle, e.unaryOp]];
e: REF log expressionNode => v← RealFns.Ln[ev[handle, e.unaryOp]];
e: REF sqrt expressionNode => v← RealFns.SqRt[ev[handle, e.unaryOp]];
e: REF neg expressionNode => v← -ev[handle, e.unaryOp];
e: REF not expressionNode =>
v← IF ev[handle, e.unaryOp] # 0.0 THEN 0.0 ELSE 1.0;
e: REF load expressionNode => v← getParmValue[handle, e.var];
e: REF store expressionNode=>
putParmValue[handle, e.var, ev[handle, e.expr]];
e: REF num expressionNode => v← e.v;
ENDCASE => v← 0.0;
}; -- ev
END.
CHANGE LOG
Wilhelm, March 23, 1982 3:41 PM.
Barth, 7-May-82 10:52:27 PDT
Chen, April 19, 1983 1:00 PM, modified arithExpr and ev to support Max and Min operations.
Barth, July 11, 1983 11:04 AM, checked for v=NIL in assignExpr.
Chen, June 10, 1984 4:43:03 pm PDT, cedarized.