home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 0 / 0988 / tclExpr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-12-28  |  16.2 KB  |  681 lines
  1. /* 
  2.  * tclExpr.c --
  3.  *
  4.  *    This file contains the code to evaluate expressions for
  5.  *    Tcl.
  6.  *
  7.  * Copyright 1987 Regents of the University of California
  8.  * Permission to use, copy, modify, and distribute this
  9.  * software and its documentation for any purpose and without
  10.  * fee is hereby granted, provided that the above copyright
  11.  * notice appear in all copies.  The University of California
  12.  * makes no representations about the suitability of this
  13.  * software for any purpose.  It is provided "as is" without
  14.  * express or implied warranty.
  15.  */
  16.  
  17. #ifndef lint
  18. static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclExpr.c,v 1.11 90/01/27 14:44:32 ouster Exp $ SPRITE (Berkeley)";
  19. #endif /* not lint */
  20.  
  21. #include <stdio.h>
  22. #include <ctype.h>
  23. #include "tcl.h"
  24. #include "tclInt.h"
  25.  
  26. /*
  27.  * The data structure below describes the state of parsing an expression.
  28.  * It's passed among the routines in this module.
  29.  */
  30.  
  31. typedef struct {
  32.     Tcl_Interp *interp;        /* Intepreter to use for command execution
  33.                  * and variable lookup. */
  34.     char *originalExpr;        /* The entire expression, as originally
  35.                  * passed to Tcl_Expr. */
  36.     char *expr;            /* Position to the next character to be
  37.                  * scanned from the expression string. */
  38.     int token;            /* Type of the last token to be parsed from
  39.                  * expr.  See below for definitions.
  40.                  * Corresponds to the characters just
  41.                  * before expr. */
  42.     int number;            /* If token is NUMBER, gives value of
  43.                  * the number. */
  44. } ExprInfo;
  45.  
  46. /*
  47.  * The token types are defined below.  In addition, there is a table
  48.  * associating a precedence with each operator.  The order of types
  49.  * is important.  Consult the code before changing it.
  50.  */
  51.  
  52. #define NUMBER        0
  53. #define OPEN_PAREN    1
  54. #define CLOSE_PAREN    2
  55. #define END        3
  56. #define UNKNOWN        4
  57.  
  58. /*
  59.  * Binary operators:
  60.  */
  61.  
  62. #define MULT        8
  63. #define DIVIDE        9
  64. #define MOD        10
  65. #define PLUS        11
  66. #define MINUS        12
  67. #define LEFT_SHIFT    13
  68. #define RIGHT_SHIFT    14
  69. #define LESS        15
  70. #define GREATER        16
  71. #define LEQ        17
  72. #define GEQ        18
  73. #define EQUAL        19
  74. #define NEQ        20
  75. #define BIT_AND        21
  76. #define BIT_XOR        22
  77. #define BIT_OR        23
  78. #define AND        24
  79. #define OR        25
  80.  
  81. /*
  82.  * Unary operators:
  83.  */
  84.  
  85. #define    UNARY_MINUS    26
  86. #define NOT        27
  87. #define BIT_NOT        28
  88.  
  89. /*
  90.  * Precedence table.  The values for non-operator token types are ignored.
  91.  */
  92.  
  93. int precTable[] = {
  94.     0, 0, 0, 0, 0, 0, 0, 0,
  95.     10, 10, 10,                /* MULT, DIVIDE, MOD */
  96.     9, 9,                /* PLUS, MINUS */
  97.     8, 8,                /* LEFT_SHIFT, RIGHT_SHIFT */
  98.     7, 7, 7, 7,                /* LESS, GREATER, LEQ, GEQ */
  99.     6, 6,                /* EQUAL, NEQ */
  100.     5,                    /* BIT_AND */
  101.     4,                    /* BIT_XOR */
  102.     3,                    /* BIT_OR */
  103.     2,                    /* AND */
  104.     1,                    /* OR */
  105.     11, 11, 11                /* UNARY_MINUS, NOT, BIT_NOT */
  106. };
  107.  
  108. /*
  109.  *----------------------------------------------------------------------
  110.  *
  111.  * ExprGetNum --
  112.  *
  113.  *    Parse off a number from a string.
  114.  *
  115.  * Results:
  116.  *    The return value is the integer value corresponding to the
  117.  *    leading digits of string.  If termPtr isn't NULL, *termPtr
  118.  *    is filled in with the address of the character after the
  119.  *    last one that is part of the number.
  120.  *
  121.  * Side effects:
  122.  *    None.
  123.  *
  124.  *----------------------------------------------------------------------
  125.  */
  126.  
  127. int
  128. ExprGetNum(string, termPtr)
  129.     register char *string;        /* ASCII representation of number.
  130.                      * If leading digit is "0" then read
  131.                      * in base 8;  if "0x", then read in
  132.                      * base 16. */
  133.     register char **termPtr;        /* If non-NULL, fill in with address
  134.                      * of terminating character. */
  135. {
  136.     int result, sign;
  137.     register char c;
  138.  
  139.     c = *string;
  140.     result = 0;
  141.     if (c == '-') {
  142.     sign = -1;
  143.     string++; c = *string;
  144.     } else {
  145.     sign = 1;
  146.     }
  147.     if (c == '0') {
  148.     string++; c = *string;
  149.     if (c == 'x') {
  150.         while (1) {
  151.         string++; c = *string;
  152.         if ((c >= '0') && (c <= '9')) {
  153.             result = (result << 4) + (c - '0');
  154.         } else if ((c >= 'a') && (c <= 'f')) {
  155.             result = (result << 4) + 10 + (c - 'a');
  156.         } else if ((c >= 'A') && (c <= 'F')) {
  157.             result = (result << 4) + 10 + (c - 'A');
  158.         } else {
  159.             break;
  160.         }
  161.         }
  162.     } else {
  163.         while ((c >= '0') && (c <= '7')) {
  164.         result = (result << 3) + (c - '0');
  165.         string++;  c = *string;
  166.         }
  167.     }
  168.     } else {
  169.     while ((c >= '0') && (c <= '9')) {
  170.         result = (result*10) + (c - '0');
  171.         string++;  c = *string;
  172.     }
  173.     }
  174.     if (termPtr != NULL) {
  175.     *termPtr = string;
  176.     }
  177.     return result*sign;
  178. }
  179.  
  180. /*
  181.  *----------------------------------------------------------------------
  182.  *
  183.  * ExprLex --
  184.  *
  185.  *    Lexical analyzer for expression parser.
  186.  *
  187.  * Results:
  188.  *    TCL_OK is returned unless an error occurred while doing lexical
  189.  *    analysis or executing an embedded command.  In that case a
  190.  *    standard Tcl error is returned, using interp->result to hold
  191.  *    an error message.  In the event of a successful return, the token
  192.  *    and (possibly) number fields in infoPtr are updated to refer to
  193.  *    the next symbol in the expression string, and the expr field is
  194.  *    advanced.
  195.  *
  196.  * Side effects:
  197.  *    None.
  198.  *
  199.  *----------------------------------------------------------------------
  200.  */
  201.  
  202. int
  203. ExprLex(interp, infoPtr)
  204.     Tcl_Interp *interp;            /* Interpreter to use for error
  205.                      * reporting. */
  206.     register ExprInfo *infoPtr;        /* Describes the state of the parse. */
  207. {
  208.     register char *p, c;
  209.     char *var, *term;
  210.     int result;
  211.  
  212.     /*
  213.      * The next token is either:
  214.      * (a)    a variable name (indicated by a $ sign plus a variable
  215.      *        name in the standard Tcl fashion);  lookup the value
  216.      *        of the variable and return its numeric equivalent as a
  217.      *        number.
  218.      * (b)    an embedded command (anything between '[' and ']').
  219.      *        Execute the command and convert its result to a number.
  220.      * (c)    a series of decimal digits.  Convert it to a number.
  221.      * (d)    space:  skip it.
  222.      * (d)    an operator.  See what kind it is.
  223.      */
  224.  
  225.     p = infoPtr->expr;
  226.     c = *p;
  227.     while (isspace(c)) {
  228.     p++;  c = *p;
  229.     }
  230.     infoPtr->expr = p+1;
  231.     if (!isascii(c)) {
  232.     infoPtr->token = UNKNOWN;
  233.     return TCL_OK;
  234.     }
  235.     switch (c) {
  236.     case '0':
  237.     case '1':
  238.     case '2':
  239.     case '3':
  240.     case '4':
  241.     case '5':
  242.     case '6':
  243.     case '7':
  244.     case '8':
  245.     case '9':
  246.         infoPtr->token = NUMBER;
  247.         infoPtr->number = ExprGetNum(p, &infoPtr->expr);
  248.         return TCL_OK;
  249.  
  250.     case '$':
  251.         infoPtr->token = NUMBER;
  252.         var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
  253.         if (var == '\0') {
  254.         return TCL_ERROR;
  255.         }
  256.         if (((Interp *) infoPtr->interp)->noEval) {
  257.         infoPtr->number = 0;
  258.         return TCL_OK;
  259.         }
  260.         infoPtr->number = ExprGetNum(var, &term);
  261.         if ((term == var) || (*term != 0)) {
  262.         c = *infoPtr->expr;
  263.         *infoPtr->expr = 0;
  264.         Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  265.         sprintf(interp->result,
  266.             "variable \"%.50s\" contained non-numeric value \"%.50s\"",
  267.             p, var);
  268.         *infoPtr->expr = c;
  269.         return TCL_ERROR;
  270.         }
  271.         return TCL_OK;
  272.  
  273.     case '[':
  274.         infoPtr->token = NUMBER;
  275.         result = Tcl_Eval(infoPtr->interp, p+1, TCL_BRACKET_TERM,
  276.             &infoPtr->expr);
  277.         if (result != TCL_OK) {
  278.         return result;
  279.         }
  280.         infoPtr->expr++;
  281.         if (((Interp *) infoPtr->interp)->noEval) {
  282.         infoPtr->number = 0;
  283.         Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  284.         return TCL_OK;
  285.         }
  286.         infoPtr->number = ExprGetNum(interp->result, &term);
  287.         if ((term == interp->result) || (*term != 0)) {
  288.         char string[200];
  289.         infoPtr->expr[-1];
  290.         infoPtr->expr[-1] = 0;
  291.         sprintf(string, "command \"%.50s\" returned non-numeric result \"%.50s\"",
  292.             p+1, interp->result);
  293.         infoPtr->expr[-1] = c;
  294.         Tcl_Return(interp, string, TCL_VOLATILE);
  295.         return TCL_ERROR;
  296.         }
  297.         Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  298.         return TCL_OK;
  299.  
  300.     case '(':
  301.         infoPtr->token = OPEN_PAREN;
  302.         return TCL_OK;
  303.  
  304.     case ')':
  305.         infoPtr->token = CLOSE_PAREN;
  306.         return TCL_OK;
  307.  
  308.     case '*':
  309.         infoPtr->token = MULT;
  310.         return TCL_OK;
  311.  
  312.     case '/':
  313.         infoPtr->token = DIVIDE;
  314.         return TCL_OK;
  315.  
  316.     case '%':
  317.         infoPtr->token = MOD;
  318.         return TCL_OK;
  319.  
  320.     case '+':
  321.         infoPtr->token = PLUS;
  322.         return TCL_OK;
  323.  
  324.     case '-':
  325.         infoPtr->token = MINUS;
  326.         return TCL_OK;
  327.  
  328.     case '<':
  329.         switch (p[1]) {
  330.         case '<':
  331.             infoPtr->expr = p+2;
  332.             infoPtr->token = LEFT_SHIFT;
  333.             break;
  334.         case '=':
  335.             infoPtr->expr = p+2;
  336.             infoPtr->token = LEQ;
  337.             break;
  338.         default:
  339.             infoPtr->token = LESS;
  340.             break;
  341.         }
  342.         return TCL_OK;
  343.  
  344.     case '>':
  345.         switch (p[1]) {
  346.         case '>':
  347.             infoPtr->expr = p+2;
  348.             infoPtr->token = RIGHT_SHIFT;
  349.             break;
  350.         case '=':
  351.             infoPtr->expr = p+2;
  352.             infoPtr->token = GEQ;
  353.             break;
  354.         default:
  355.             infoPtr->token = GREATER;
  356.             break;
  357.         }
  358.         return TCL_OK;
  359.  
  360.     case '=':
  361.         if (p[1] == '=') {
  362.         infoPtr->expr = p+2;
  363.         infoPtr->token = EQUAL;
  364.         } else {
  365.         infoPtr->token = UNKNOWN;
  366.         }
  367.         return TCL_OK;
  368.  
  369.     case '!':
  370.         if (p[1] == '=') {
  371.         infoPtr->expr = p+2;
  372.         infoPtr->token = NEQ;
  373.         } else {
  374.         infoPtr->token = NOT;
  375.         }
  376.         return TCL_OK;
  377.  
  378.     case '&':
  379.         if (p[1] == '&') {
  380.         infoPtr->expr = p+2;
  381.         infoPtr->token = AND;
  382.         } else {
  383.         infoPtr->token = BIT_AND;
  384.         }
  385.         return TCL_OK;
  386.  
  387.     case '^':
  388.         infoPtr->token = BIT_XOR;
  389.         return TCL_OK;
  390.  
  391.     case '|':
  392.         if (p[1] == '|') {
  393.         infoPtr->expr = p+2;
  394.         infoPtr->token = OR;
  395.         } else {
  396.         infoPtr->token = BIT_OR;
  397.         }
  398.         return TCL_OK;
  399.  
  400.     case '~':
  401.         infoPtr->token = BIT_NOT;
  402.         return TCL_OK;
  403.  
  404.     case 0:
  405.         infoPtr->token = END;
  406.         infoPtr->expr = p;
  407.         return TCL_OK;
  408.  
  409.     default:
  410.         infoPtr->expr = p+1;
  411.         infoPtr->token = UNKNOWN;
  412.         return TCL_OK;
  413.     }
  414. }
  415.  
  416. /*
  417.  *----------------------------------------------------------------------
  418.  *
  419.  * ExprGetValue --
  420.  *
  421.  *    Parse a "value" from the remainder of the expression in infoPtr.
  422.  *
  423.  * Results:
  424.  *    Normally TCL_OK is returned.  The value of the parsed number is
  425.  *    returned in infoPtr->number.  If an error occurred, then
  426.  *    interp->result contains an error message and TCL_ERROR is returned.
  427.  *
  428.  * Side effects:
  429.  *    Information gets parsed from the remaining expression, and the
  430.  *    expr and token fields in infoPtr get updated.  Information is
  431.  *    parsed until either the end of the expression is reached (null
  432.  *    character or close paren), an error occurs, or a binary operator
  433.  *    is encountered with precedence <= prec.  In any of these cases,
  434.  *    infoPtr->token will be left pointing to the token AFTER the
  435.  *    expression.
  436.  *
  437.  *----------------------------------------------------------------------
  438.  */
  439.  
  440. int
  441. ExprGetValue(interp, infoPtr, prec)
  442.     Tcl_Interp *interp;            /* Interpreter to use for error
  443.                      * reporting. */
  444.     register ExprInfo *infoPtr;        /* Describes the state of the parse
  445.                      * just before the value (i.e. ExprLex
  446.                      * will be called to get first token
  447.                      * of value). */
  448.     int prec;                /* Treat any un-parenthesized operator
  449.                      * with precedence <= this as the end
  450.                      * of the expression. */
  451. {
  452.     Interp *iPtr = (Interp *) interp;
  453.     int result, operator, operand;
  454.     int gotOp;                /* Non-zero means already lexed the
  455.                      * operator (while picking up value
  456.                      * for unary operator).  Don't lex
  457.                      * again. */
  458.  
  459.     /*
  460.      * There are two phases to this procedure.  First, pick off an initial
  461.      * value.  Then, parse (binary operator, value) pairs until done.
  462.      */
  463.  
  464.     gotOp = 0;
  465.     result = ExprLex(interp, infoPtr);
  466.     if (result != TCL_OK) {
  467.     return result;
  468.     }
  469.     if (infoPtr->token == OPEN_PAREN) {
  470.  
  471.     /*
  472.      * Parenthesized sub-expression.
  473.      */
  474.  
  475.     result = ExprGetValue(interp, infoPtr, -1);
  476.     if (result != TCL_OK) {
  477.         return result;
  478.     }
  479.     if (infoPtr->token != CLOSE_PAREN) {
  480.         Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  481.         sprintf(interp->result,
  482.             "unmatched parentheses in expression \"%.50s\"",
  483.             infoPtr->originalExpr);
  484.         return TCL_ERROR;
  485.     }
  486.     } else {
  487.     if (infoPtr->token == MINUS) {
  488.         infoPtr->token = UNARY_MINUS;
  489.     }
  490.     if (infoPtr->token >= UNARY_MINUS) {
  491.  
  492.         /*
  493.          * Process unary operators.
  494.          */
  495.  
  496.         operator = infoPtr->token;
  497.         result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token]);
  498.         if (result != TCL_OK) {
  499.         return result;
  500.         }
  501.         switch (operator) {
  502.         case UNARY_MINUS:
  503.             infoPtr->number = -infoPtr->number;
  504.             break;
  505.         case NOT:
  506.             infoPtr->number = !infoPtr->number;
  507.             break;
  508.         case BIT_NOT:
  509.             infoPtr->number = ~infoPtr->number;
  510.             break;
  511.         }
  512.         gotOp = 1;
  513.     } else if (infoPtr->token != NUMBER) {
  514.         goto syntaxError;
  515.     }
  516.     }
  517.  
  518.     /*
  519.      * Got the first operand.  Now fetch (operator, operand) pairs.
  520.      */
  521.  
  522.     if (!gotOp) {
  523.     result = ExprLex(interp, infoPtr);
  524.     if (result != TCL_OK) {
  525.         return result;
  526.     }
  527.     }
  528.     while (1) {
  529.     operand = infoPtr->number;
  530.     operator = infoPtr->token;
  531.     if ((operator < MULT) || (operator >= UNARY_MINUS)) {
  532.         if ((operator == END) || (operator == CLOSE_PAREN)) {
  533.         return TCL_OK;
  534.         } else {
  535.         goto syntaxError;
  536.         }
  537.     }
  538.     if (precTable[operator] <= prec) {
  539.         return TCL_OK;
  540.     }
  541.  
  542.     /*
  543.      * If we're doing an AND or OR and the first operand already
  544.      * determines the result, don't execute anything in the
  545.      * second operand:  just parse.
  546.      */
  547.  
  548.     if (((operator == AND) && !operand)
  549.         || ((operator == OR) && operand)) {
  550.         iPtr->noEval++;
  551.         result = ExprGetValue(interp, infoPtr, precTable[operator]);
  552.         iPtr->noEval--;
  553.     } else {
  554.         result = ExprGetValue(interp, infoPtr, precTable[operator]);
  555.     }
  556.     if (result != TCL_OK) {
  557.         return result;
  558.     }
  559.     if ((infoPtr->token < MULT) && (infoPtr->token != NUMBER)
  560.         && (infoPtr->token != END)
  561.         && (infoPtr->token != CLOSE_PAREN)) {
  562.         goto syntaxError;
  563.     }
  564.     switch (operator) {
  565.         case MULT:
  566.         infoPtr->number = operand * infoPtr->number;
  567.         break;
  568.         case DIVIDE:
  569.         if (infoPtr->number == 0) {
  570.             Tcl_Return(interp, "divide by zero", TCL_STATIC);
  571.             return TCL_ERROR;
  572.             }
  573.         infoPtr->number = operand / infoPtr->number;
  574.         break;
  575.         case MOD:
  576.         if (infoPtr->number == 0) {
  577.             Tcl_Return(interp, "divide by zero", TCL_STATIC);
  578.             return TCL_ERROR;
  579.             }
  580.         infoPtr->number = operand % infoPtr->number;
  581.         break;
  582.         case PLUS:
  583.         infoPtr->number = operand + infoPtr->number;
  584.         break;
  585.         case MINUS:
  586.         infoPtr->number = operand - infoPtr->number;
  587.         break;
  588.         case LEFT_SHIFT:
  589.         infoPtr->number = operand << infoPtr->number;
  590.         break;
  591.         case RIGHT_SHIFT:
  592.         infoPtr->number = operand >> infoPtr->number;
  593.         break;
  594.         case LESS:
  595.         infoPtr->number = operand < infoPtr->number;
  596.         break;
  597.         case GREATER:
  598.         infoPtr->number = operand > infoPtr->number;
  599.         break;
  600.         case LEQ:
  601.         infoPtr->number = operand <= infoPtr->number;
  602.         break;
  603.         case GEQ:
  604.         infoPtr->number = operand >= infoPtr->number;
  605.         break;
  606.         case EQUAL:
  607.         infoPtr->number = operand == infoPtr->number;
  608.         break;
  609.         case NEQ:
  610.         infoPtr->number = operand != infoPtr->number;
  611.         break;
  612.         case BIT_AND:
  613.         infoPtr->number = operand & infoPtr->number;
  614.         break;
  615.         case BIT_XOR:
  616.         infoPtr->number = operand ^ infoPtr->number;
  617.         break;
  618.         case BIT_OR:
  619.         infoPtr->number = operand | infoPtr->number;
  620.         break;
  621.         case AND:
  622.         infoPtr->number = operand && infoPtr->number;
  623.         break;
  624.         case OR:
  625.         infoPtr->number = operand || infoPtr->number;
  626.         break;
  627.     }
  628.     }
  629.  
  630.     syntaxError:
  631.     Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  632.     sprintf(interp->result, "syntax error in expression \"%.50s\"",
  633.         infoPtr->originalExpr);
  634.     return TCL_ERROR;
  635. }
  636.  
  637. /*
  638.  *----------------------------------------------------------------------
  639.  *
  640.  * Tcl_Expr --
  641.  *
  642.  *    Parse and evaluate an expression.
  643.  *
  644.  * Results:
  645.  *    The return value is TCL_OK if the expression was correctly parsed;
  646.  *    if there was a syntax error or some other error during parsing,
  647.  *    then another Tcl return value is returned and Tcl_Result points
  648.  *    to an error message.  If all went well, *valuePtr is filled in
  649.  *    with the result corresponding to the expression string.
  650.  *
  651.  * Side effects:
  652.  *    None.
  653.  *
  654.  *----------------------------------------------------------------------
  655.  */
  656.  
  657. int
  658. Tcl_Expr(interp, string, valuePtr)
  659.     Tcl_Interp *interp;        /* Intepreter to use for variables etc. */
  660.     char *string;        /* Expression to evaluate. */
  661.     int *valuePtr;        /* Where to store result of evaluation. */
  662. {
  663.     ExprInfo info;
  664.     int result;
  665.  
  666.     info.interp = interp;
  667.     info.originalExpr = string;
  668.     info.expr = string;
  669.     result = ExprGetValue(interp, &info, -1);
  670.     if (result != TCL_OK) {
  671.     return result;
  672.     }
  673.     if (info.token != END) {
  674.     Tcl_Return(interp, (char *) NULL, TCL_STATIC);
  675.     sprintf(interp->result, "syntax error in expression \"%.50s\"", string);
  676.     return TCL_ERROR;
  677.     }
  678.     *valuePtr = info.number;
  679.     return TCL_OK;
  680. }
  681.