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
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 => {
n _ Variable[handle, newString, context, allLevels];
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];
};
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.
\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
the "variable" below searchs for newString on currentCkt, all levels, to get a nPtr of types RefParmRec, RefNodeRec, or RefConRec. then Next[].
when item=name, type_ real only if n=nil or n points to a parameter, otherwise it gets name.
string => {
type_ real;
f_ NEW[num expressionNode_
[operands: num[v: LOOPHOLE[newString, REAL]] ] ];
Next[handle]
};
Κ –

"cedar" style˜Icodeš
œ™Kš
œ>™>™K™0K™0Kšœ(Οk™+—K˜š
	˜	Kšœœ$˜.Kšœœ˜%Kšœ
œˆ
˜š
—K˜šΟnœœ
˜š
˜Kš
œ˜Kš
œ˜Kš
œ˜—š
˜Kš
œ˜——K˜šœ˜Kšœ˜—K˜šžœœ#œ˜KKšœ
˜Kš
œ˜šœ˜š
œ
˜
Kš
œ
˜
Kš
œ˜Kšœ
œœ˜8Kš
œ˜—š
œ	˜	Kš
œ
™
Kš
œ4˜4Kš
œ\™\šœœœ
œ˜šœ
œœ
˜Kšœœ	˜'——Kšœœ4œ˜CKš
œ˜—š
œ˜Kš
œ˜Kšœœ1˜8Kš
œ
˜
Kš
œ˜—š
œ™Kš
œ™Kšœœ™Kšœœœ™1Kš
œ™Kš
œ™—Kšœ˜—KšœΟc	˜—K˜šž	œœ#œ˜NKšœ
˜šœ˜š
œA˜AKš
œ˜Kš
œ
˜
šœœ	˜šœ
œ˜%Kš
œ9˜9—šœœ˜&Kš
œ9˜9—šœ
œ˜%Kš
œ9˜9—šœœ˜(Kš
œ9˜9—šœœ˜)Kš
œ9˜9—šœœ˜'Kš
œ9˜9—šœœ˜'Kš
œ9˜9——Kšœ
œ˜'Kš
œ˜—Kšœ ˜'—KšœŸ˜—K˜šž	œœ#œ˜PKšœ
˜Kš
œ˜Kš
œ!˜!šœœ˜Kšœ
œ˜'Kš
œ
˜
šœ
œ˜$Kš
œG˜G—Kšœ
œ˜'Kš
œ˜Kš
œ˜—KšœŸ˜—K˜šžœœ#œ˜KKšœ
˜Kšœœ
˜Kš
œ˜Kš
œ!˜!Kš
œœœ
œ
œ˜Gšœœ˜ Kš
œ˜Kš
œ
˜
šœ
œœ
œ˜0Kš
œD˜D—šœ
œ˜Kš
œE˜E—Kšœ
œ˜'Kš
œ˜Kšœ
˜—KšœŸ˜
—K˜šž	œœ#œ˜OKšœ
˜Kš
œ˜Kš
œ˜Kš
œ˜š	œœ
œœ˜CKšœ
œ˜'—š	œœ
œœ˜DKš
œ˜Kš
œ
˜
šœ	œ
˜šœœ˜ Kš
œ?˜?—šœ	œ˜!Kš
œ?˜?—šœœ˜#Kš
œ?˜?—šœœ˜#Kš
œ?˜?——Kšœ
œ˜'Kš
œ˜Kšœ
˜—KšœŸ˜—K˜šžœœ#œ˜LKšœ
˜Kš
œ˜Kšœœ
˜
Kš
œ˜šœ˜š
œ7˜7Kš
œ˜Kš
œ
˜
Kšœœ˜(Kšœ
œ	œ˜3šœœ	˜šœœ˜#Kš
œC˜C—šœœ˜&Kš
œC˜C—šœœ˜ Kš
œC˜C—šœ
œ˜%Kš
œC˜C—šœ	œ˜ Kš
œC˜C—šœœ˜#Kš
œC˜C——Kšœ
œ	œ˜3Kš
œ˜Kš
œ
˜
Kš
œ˜—Kšœ
˜—KšœŸ
˜
—K˜šžœœ#œ˜MKšœ
˜Kš
œ˜Kš
œ˜šœ˜Kšœ
œ˜'—šœœ
Ÿ˜,Kš
œ
˜
šœœ˜Kš
œB˜B—Kšœœ˜3Kš
œ˜Kšœ
˜—KšœŸ
˜
—K˜šž
œœ
œ#œ˜VKšœ
˜Kš
œ˜Kš
œ˜Kšœœ
œ
œ˜=šœœ
Ÿ˜0Kš
œ
˜
šœœ˜Kš
œ@˜@—Kšœœ˜3Kš
œ
˜
Kšœ
˜—KšœŸ
˜—K˜šž
œœ
œ0œ˜cKšœ
˜Kšœ7Ÿ
˜Dš
œœ
œ
œœ
œ
Ÿ˜IKšœœ
˜Kšœ˜—Kšœœœ˜<KšœœX˜_Kšœ
œ˜'KšœŸ
˜—K˜š
žœœ
œ%œœ˜Išœ˜šœœœ
œ
˜%Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ˜—Kš
œ˜Kš
œ˜—Kš
œ˜KšœŸ˜
—K˜šžœœ%œœ˜@Kšœœ
œ
œ˜šœœ
˜šœœ˜Kšœœ.˜5—šœœ˜Kšœœ.˜5—šœœ˜Kš
œ1˜1—šœœ˜Kš
œ1˜1—šœœ˜Kš
œ1˜1—šœœ˜Kš
œ1˜1—šœœ˜š	œœœœ
œ˜7Kš
œœ
œœœ˜B——šœœ˜š	œœœœ
œ˜7Kš
œœ
œœœ˜B——šœœ˜Kšœœ0œœ˜H—šœœ˜Kšœœ0œœ˜H—šœœ˜Kšœœ1œœ˜I—šœœ˜Kšœœ1œœ˜I—šœœ˜Kšœœ4œœ˜L—šœœ˜Kš	œœœœœ˜W—šœœ˜Kšœœ˜Kšœœ˜ šœ
œœœ˜1Kš
œ˜Kšœœœœ
˜6Kšœ	œ˜Kš
œ
˜
—Kšœ@˜DKš
œ˜—Kšœœ=˜CKšœœœ˜<Kšœœ>˜DKšœœ=˜CKšœœ@˜FKšœœ2˜8Kš	œœœœœ˜RKšœœ8˜>KšœœI˜OKšœœ˜%Kšœ˜—KšœŸ˜—K˜Kšœ
˜K˜šœ
˜
K˜Kšœœ
˜!Kšœ˜Kšœœ>˜[Kšœœœ˜@Kšœœ˜.Kšœœ ˜@Kšœœ˜0——…—&4