
    <<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: 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.
        Chen, May 9, 1985 4:53:24 pm PDT, RealOps.SqRt => RealFns.SqRt .
        Chen, July 22, 1985 8:03:01 pm PDT, => Cedar6.0.