<Cedar5.2>System>spExpressions.mesa>> <> 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 => { <> n_ variable[handle, newString, NIL]; <> 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]; }; < {>> <> <> <<[operands: num[v: LOOPHOLE[newString, REAL]] ] ];>> <> <<};>> 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; }; }; -- powerExp 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. <> <> <> <> <> <> < RealFns.SqRt .>>