-- File: [Thyme]<Thyme>System>CSIM01>spExpressions.mesa
-- Last editted:
-- by Barth, July 11, 1983  11:04 AM.
-- SChen April 19, 1983  1:00 PM.
-- Wilhelm March 23, 1982  3:41 PM, reformated by Barth and stored under
--   [Cherry]<Barth>Thyme>1.97> .
-- Details at end of file.
DIRECTORY spGlobals, AltoDefs, Real, RealFns;
spExpressions:  PROGRAM
  IMPORTS spGlobals, Real, RealFns
  EXPORTS spGlobals =
  BEGIN
    OPEN spGlobals;

    Types:  TYPE = {real, name};
    type:   Types;

    factor:  PROCEDURE RETURNS[f:  expressionPtr] =
      BEGIN
        n: namePtr;

        SELECT item FROM
          leftP =>
            BEGIN
              next[];
              f _ expression[];
              IF item = rightP THEN next[] ELSE error[211]
            END;
          name =>
            BEGIN
              f _ makeExpr[];
              n _ variable[NIL];
              type _ IF n # NIL THEN
                       IF n^.nType = parmName THEN real ELSE name
                     ELSE real;
              f^.operands _ load[n, NIL]
            END;
          number =>
            BEGIN
              type _ real;
              f _ makeExpr[];
              f^.operands _ num[value];
              next[]
            END;
          string =>
            BEGIN
              type _ real;
              f _ makeExpr[];
              f^.operands _ num[LOOPHOLE[newString, REAL]];
              next[]
            END
        ENDCASE => error[209]
      END;

    unaryExpr:  PROCEDURE RETURNS[u:  expressionPtr] =
      BEGIN
        oldItem:  itemType;

        SELECT item FROM
          minus, atSign, upArrow, backSlash, slash, squiggle, vertical =>
            BEGIN
              oldItem _ item;
              next[];
              u _ makeExpr[];
              SELECT oldItem FROM
                minus      => u^.operands _ neg[unaryExpr[]];
                atSign     => u^.operands _ abs[unaryExpr[]];
                slash      => u^.operands _ sqrt[unaryExpr[]];
                squiggle   => u^.operands _ not[unaryExpr[]];
                backSlash  => u^.operands _ log[unaryExpr[]];
                upArrow    => u^.operands _ exp[unaryExpr[]];
                vertical   => u^.operands _ int[unaryExpr[]]
              ENDCASE;
              IF type > real THEN error[270]
            END
        ENDCASE => u _ factor[]
      END;

    powerExpr:  PROCEDURE RETURNS[p:  expressionPtr] =
      BEGIN
        p2:  expressionPtr;

        p _ unaryExpr[];
        IF item = upArrow THEN
          BEGIN
            IF type > real THEN error[270];
            next[];
            p2 _ makeExpr[];
            p2^.operands _ power[p, unaryExpr[]];
            IF type > real THEN error[270];
            p _ p2
          END
      END;

    term:  PROCEDURE RETURNS[t:  expressionPtr] =
      BEGIN
        mulOp:  BOOLEAN;
        t2:  expressionPtr;

        t _ powerExpr[];
        IF item = star OR item = slash THEN
          IF type > real THEN error[270];
        WHILE item = star OR item = slash DO
          mulOp _ item = star;
          next[];
          t2 _ makeExpr[];
          IF mulOp THEN t2^.operands _ mul[t, powerExpr[]]
          ELSE t2^.operands _ div[t, powerExpr[]];
          IF type > real THEN error[270];
          t _ t2
        ENDLOOP
      END;

    arithExpr:  PROCEDURE RETURNS[e:  expressionPtr] =
      BEGIN
        e2:  expressionPtr;

        e _ term[];
        IF (item = plus OR item = minus) OR
          (item = maximum OR item = minimum) THEN
          IF type > real THEN error[270];
        WHILE (item = plus OR item = minus) OR 
          (item = maximum OR item = minimum) DO
          oldItem: itemType_ item;
          next[];
          e2 _ makeExpr[];
          SELECT oldItem FROM
            plus    => e2^.operands_ add[e, term[]];
            minus   => e2^.operands_ sub[e, term[]];
            maximum => e2^.operands_ max[e, term[]];
            ENDCASE => e2^.operands_ min[e, term[]];
          IF type > real THEN error[270];
          e _ e2
        ENDLOOP
      END;

    relExpr:  PROCEDURE RETURNS[r:  expressionPtr] =
      BEGIN
        r2:  expressionPtr;
        oldItem:  itemType;
        nodeOK:   BOOLEAN;

        r _ arithExpr[];
        SELECT item FROM
          greater, less, equal, pound, greatEqual, lessEqual =>
            BEGIN
              oldItem _ item;
              next[];
              r2 _ makeExpr[];
              nodeOK _ oldItem = equal OR oldItem = pound;
              IF type > real AND ~nodeOK THEN error[270];
              SELECT oldItem FROM
                greater =>    r2^.operands _ grt[r, arithExpr[]];
                greatEqual => r2^.operands _ geq[r, arithExpr[]];
                less =>       r2^.operands _ les[r, arithExpr[]];
                lessEqual =>  r2^.operands _ leq[r, arithExpr[]];
                equal =>      r2^.operands _ eq[r, arithExpr[]];
                pound =>      r2^.operands _ neq[r, arithExpr[]]
              ENDCASE;
              IF type > real AND ~nodeOK THEN error[270];
              type _ real;
              r _ r2
            END
        ENDCASE
      END;

    andExpr:  PROCEDURE RETURNS[e:  expressionPtr] =
      BEGIN
        e2:  expressionPtr;

        e _ relExpr[];
        IF item = amperesand THEN
          IF type > real THEN error[270];
        WHILE item = amperesand DO
          next[];
          e2 _ makeExpr[];
          e2^.operands _ and[e, relExpr[]];
          IF type > real THEN error[270];
          e _ e2
        ENDLOOP
      END;

    expression:  PUBLIC PROCEDURE RETURNS[e:  expressionPtr] =
      BEGIN
        e2:  expressionPtr;

        e _ andExpr[];
        IF item = vertical THEN
          IF type > real THEN error[270];
        WHILE item = vertical DO
          next[];
          e2 _ makeExpr[];
          e2^.operands _ or[e, andExpr[]];
          IF type > real THEN error[270];
          e _ e2
        ENDLOOP
      END;

    assignExpr:  PUBLIC PROCEDURE[leftContext:  circuitNamePtr]
                          RETURNS[a:  expressionPtr] =
      BEGIN
        v:  namePtr;

        a _ makeExpr[];
        v _ variable[leftContext];
        IF v#NIL THEN IF v^.nType # parmName THEN error[271];
        IF item = leftArrow THEN next[] ELSE error[210];
        a^.operands _ store[v, expression[]];
        IF type > real THEN error[270]
      END;

    eval:  PUBLIC PROCEDURE[exp:  expressionPtr] RETURNS[v:  REAL] =
      BEGIN
        ENABLE
          Real.RealException =>
            BEGIN
              errorCode:  CARDINAL;

              errorCode _ SELECT TRUE FROM
                            flags[divisionByZero] => 901,
                            flags[overflow]       => 902,
                            flags[underflow]      => 903,
                            flags[fixOverflow]    => 904,
                          ENDCASE => 900;
              ErrorSignal[errorCode, "?"]
            END;
        v _ ev[exp]
      END;

    ev:  PROCEDURE[exp:  expressionPtr] RETURNS[v:  REAL] =
      BEGIN
        OPEN Real, RealFns;

        x, y:  REAL;

        IF exp # NIL THEN
          WITH e:  exp^ SELECT FROM
            max   => v _ MAX[ev[e.leftOp], ev[e.rightOp]];
            min   => v _ MIN[ev[e.leftOp], ev[e.rightOp]];
            add   => v _ ev[e.leftOp] + ev[e.rightOp];
            sub   => v _ ev[e.leftOp] - ev[e.rightOp];
            mul   => v _ ev[e.leftOp] * ev[e.rightOp];
            div   => v _ ev[e.leftOp] / ev[e.rightOp];
            eq    => v _ IF LOOPHOLE[ev[e.leftOp], LONG CARDINAL] =
                            LOOPHOLE[ev[e.rightOp], LONG CARDINAL]
                         THEN 1.0
                         ELSE 0.0;
            neq   => v _ IF LOOPHOLE[ev[e.leftOp], LONG CARDINAL] #
                            LOOPHOLE[ev[e.rightOp], LONG CARDINAL]
                         THEN 1.0
                         ELSE 0.0;
            grt   => v _ IF ev[e.leftOp] > ev[e.rightOp] THEN 1.0
                         ELSE 0.0;
            les   => v _ IF ev[e.leftOp] < ev[e.rightOp] THEN 1.0
                         ELSE 0.0;
            geq   => v _ IF ev[e.leftOp] >= ev[e.rightOp] THEN 1.0
                         ELSE 0.0;
            leq   => v _ IF ev[e.leftOp] <= ev[e.rightOp] THEN 1.0
                         ELSE 0.0;
            and   => v _ IF ev[e.leftOp]*ev[e.rightOp] # 0.0 THEN 1.0
                         ELSE 0.0;
            or    => v _ IF ev[e.leftOp] # 0.0 OR
                            ev[e.rightOp] # 0.0 THEN 1.0
                         ELSE 0.0;
            power =>
              BEGIN
                x _ ev[e.leftOp];
                y _ ev[e.rightOp];
                IF ABS[y] < 100.0 AND y = FixI[y] THEN
                  BEGIN
                    v _ 1.0;
                    THROUGH[1..ABS[FixI[y]]] DO
                      v _ v*x
                    ENDLOOP;
                    IF y < 0.0 THEN v _ 1.0/v
                  END
                ELSE v _ Power[ev[e.leftOp], ev[e.rightOp]]
              END;
            int   => v _ Real.RoundLI[ev[e.unaryOp]];
            abs   => v _ ABS[ev[e.unaryOp]];
            exp   => v _ Exp[ev[e.unaryOp]];
            log   => v _ Ln[ev[e.unaryOp]];
            sqrt  => v _ SqRt[ev[e.unaryOp]];
            neg   => v _ -ev[e.unaryOp];
            not   => v _ IF ev[e.unaryOp] # 0.0 THEN 0.0 ELSE 1.0;
            load  => v _ getParmValue[e.var];
            store => putParmValue[e.var, ev[e.expr]];
            num   => v _ e.v
          ENDCASE  => v _ 0.0
        ELSE v _ 0.0
      END;
  END.
  
4/19/83:-
  original: [Cherry]<Barth>Thyme>1.97>spExpressions.mesa
  changes:
  1. arithExpr - modified to allow item = minimum or maximum.
  2. ev - added MAX and MIN operations.
July 11, 1983  11:04 AM, by Barth
checked for v=NIL in assignExpr