ThymeExpressions.mesa
Copyright (C) 1985 by Xerox Corporation. All rights reserved.
Last Edited by:
Christian LeCocq February 4, 1987 6:38:14 pm PST
Sweetsun Chen, July 22, 1985 8:04:14 pm PDT
DIRECTORY
Real USING [FixI, RealException, RoundLI],
RealFns USING [Exp, Ln, Power, SqRt],
ThymeGlobals USING [Error, ErrorSignal, expressionNode, expressionPtr, GetParmValue, Handle, itemType, namePtr, Next, PutParmValue, RefParmRec, Variable];
ThymeExpressions: CEDAR PROGRAM
IMPORTS
Real,
RealFns,
ThymeGlobals
EXPORTS
ThymeGlobals
= BEGIN
OPEN ThymeGlobals;
Factor: PROC[handle: Handle, context: namePtr] RETURNS[f: expressionPtr]= {
OPEN handle.vars;
n: namePtr;
SELECT item FROM
leftP => {
Next[handle];
f← Expression[handle, context];
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, context, allLevels];
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, context: namePtr] 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, context]] ] ],
atSign => u ← NEW[neg expressionNode ←
[operands: abs[unaryOp: UnaryExpr[handle, context]] ] ],
slash => u ← NEW[neg expressionNode ←
[operands: sqrt[unaryOp: UnaryExpr[handle, context]] ] ],
squiggle => u ← NEW[neg expressionNode ←
[operands: not[unaryOp: UnaryExpr[handle, context]] ] ],
backSlash => u ← NEW[neg expressionNode ←
[operands: log[unaryOp: UnaryExpr[handle, context]] ] ],
upArrow => u ← NEW[neg expressionNode ←
[operands: exp[unaryOp: UnaryExpr[handle, context]] ] ],
ENDCASE => u ← NEW[neg expressionNode ←
[operands: int[unaryOp: UnaryExpr[handle, context]] ] ];
IF type > real THEN Error[handle, 270];
};
ENDCASE => u ← Factor[handle, context];
}; -- UnaryExpr
PowerExpr: PROC[handle: Handle, context: namePtr] RETURNS[pwr: expressionPtr]= {
OPEN handle.vars;
pwrTemp: expressionPtr;
pwr ← UnaryExpr[handle, context];
IF item=upArrow THEN {
IF type > real THEN Error[handle, 270];
Next[handle];
pwrTemp ← NEW[power expressionNode ←
[operands: power[leftOp: pwr, rightOp: UnaryExpr[handle, context]] ] ];
IF type > real THEN Error[handle, 270];
pwr ← pwrTemp;
};
}; -- powerExp
Term: PROC[handle: Handle, context: namePtr] RETURNS[trm: expressionPtr]= {
OPEN handle.vars;
mulOp: BOOL;
trmTemp: expressionPtr;
trm ← PowerExpr[handle, context];
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, context]] ] ]
ELSE NEW[div expressionNode ←
[operands: div[leftOp: trm, rightOp: PowerExpr[handle, context]] ] ];
IF type > real THEN Error[handle, 270];
trm ← trmTemp;
ENDLOOP;
}; -- Term
ArithExpr: PROC[handle: Handle, context: namePtr] RETURNS[ar: expressionPtr]= {
OPEN handle.vars;
arTemp: expressionPtr;
itemSave: itemType;
ar← Term[handle, context];
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, context]] ] ],
minus => NEW[sub expressionNode ←
[operands: sub[leftOp: ar, rightOp: Term[handle, context]] ] ],
maximum => NEW[max expressionNode ←
[operands: max[leftOp: ar, rightOp: Term[handle, context]] ] ],
ENDCASE => NEW[min expressionNode ←
[operands: min[leftOp: ar, rightOp: Term[handle, context]] ] ];
IF type > real THEN Error[handle, 270];
ar ← arTemp;
ENDLOOP;
}; -- ArithExpr
RelExpr: PROC[handle: Handle, context: namePtr] RETURNS[r: expressionPtr]= {
OPEN handle.vars;
rTemp: expressionPtr;
nodeOK: BOOL;
r ← ArithExpr[handle, context];
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, context]] ] ],
greatEqual => NEW[geq expressionNode ←
[operands: geq[leftOp: r, rightOp: ArithExpr[handle, context]] ] ],
less => NEW[les expressionNode ←
[operands: les[leftOp: r, rightOp: ArithExpr[handle, context]] ] ],
lessEqual => NEW[leq expressionNode ←
[operands: leq[leftOp: r, rightOp: ArithExpr[handle, context]] ] ],
equal => NEW[eq expressionNode ←
[operands: eq[leftOp: r, rightOp: ArithExpr[handle, context]] ] ],
ENDCASE => NEW[neq expressionNode ←
[operands: neq[leftOp: r, rightOp: ArithExpr[handle, context]] ] ];
IF type > real AND ~nodeOK THEN Error[handle, 270];
type ← real;
r ← rTemp;
};
ENDCASE;
}; -- RelExpr
AndExpr: PROC[handle: Handle, context: namePtr] RETURNS[an: expressionPtr]= {
OPEN handle.vars;
anTemp: expressionPtr;
an← RelExpr[handle, context];
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, context]] ] ];
IF handle.vars.type > real THEN Error[handle, 270];
an← anTemp;
ENDLOOP;
}; -- AndExpr
Expression: PUBLIC PROC[handle: Handle, context: namePtr] RETURNS[o: expressionPtr]= {
OPEN handle.vars;
oTemp: expressionPtr;
o ← AndExpr[handle, context];
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, context]] ] ];
IF handle.vars.type > real THEN Error[handle, 270];
o ← oTemp;
ENDLOOP;
}; -- Expression
AssignExpr: PUBLIC PROC[handle: Handle, context, 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, context]] ] ];
IF type > real THEN Error[handle, 270];
}; -- AssignExpr
Eval: PUBLIC PROC[handle: Handle, exp: expressionPtr] RETURNS[v: REAL]= {
ENABLE Real.RealException => {
errorCode: CARDINALSELECT 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.
Chen, May 9, 1985 4:53:24 pm PDT, RealOps.SqRt => RealFns.SqRt .
Chen, July 22, 1985 8:03:01 pm PDT, => Cedar6.0.