ThymeExpressions.mesa
Copyright (C) 1985 by Xerox Corporation. All rights reserved.
Last Edited by:
Christian Le Cocq April 29, 1987 10:18:30 am PDT
Christian LeCocq February 4, 1987 6:38:14 pm PST
Sweetsun Chen, July 22, 1985 8:04:14 pm PDT
DIRECTORY
Real USING [InlineFixI, RealException, Round],
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
=
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:
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.InlineFixI[y]
THEN {
v ← 1.0;
THROUGH[1..ABS[Real.InlineFixI[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.Round[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.