root/tclExpr.c

DEFINITIONS

1. ExprInfo
2. ExprGetNum
3. ExprLex
4. ExprGetValue
5. Tcl_Expr

/* 
 * tclExpr.c --
 *
 *      This file contains the code to evaluate expressions for
 *      Tcl.
 *
 * Copyright 1987 Regents of the University of California
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclExpr.c,v 1.11 90/01/27 14:44:32 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */

#include <stdio.h>
#include <ctype.h>
#include "tcl.h"
#include "tclInt.h"

/*
 * The data structure below describes the state of parsing an expression.
 * It's passed among the routines in this module.
 */

typedef struct {
    Tcl_Interp *interp;         /* Intepreter to use for command execution
                                 * and variable lookup. */
    char *originalExpr;         /* The entire expression, as originally
                                 * passed to Tcl_Expr. */
    char *expr;                 /* Position to the next character to be
                                 * scanned from the expression string. */
    int token;                  /* Type of the last token to be parsed from
                                 * expr.  See below for definitions.
                                 * Corresponds to the characters just
                                 * before expr. */
    int number;                 /* If token is NUMBER, gives value of
                                 * the number. */
} ExprInfo;

/*
 * The token types are defined below.  In addition, there is a table
 * associating a precedence with each operator.  The order of types
 * is important.  Consult the code before changing it.
 */

#define NUMBER          0
#define OPEN_PAREN      1
#define CLOSE_PAREN     2
#define END             3
#define UNKNOWN         4

/*
 * Binary operators:
 */

#define MULT            8
#define DIVIDE          9
#define MOD             10
#define PLUS            11
#define MINUS           12
#define LEFT_SHIFT      13
#define RIGHT_SHIFT     14
#define LESS            15
#define GREATER         16
#define LEQ             17
#define GEQ             18
#define EQUAL           19
#define NEQ             20
#define BIT_AND         21
#define BIT_XOR         22
#define BIT_OR          23
#define AND             24
#define OR              25

/*
 * Unary operators:
 */

#define UNARY_MINUS     26
#define NOT             27
#define BIT_NOT         28

/*
 * Precedence table.  The values for non-operator token types are ignored.
 */

int precTable[] = {
    0, 0, 0, 0, 0, 0, 0, 0,
    10, 10, 10,                         /* MULT, DIVIDE, MOD */
    9, 9,                               /* PLUS, MINUS */
    8, 8,                               /* LEFT_SHIFT, RIGHT_SHIFT */
    7, 7, 7, 7,                         /* LESS, GREATER, LEQ, GEQ */
    6, 6,                               /* EQUAL, NEQ */
    5,                                  /* BIT_AND */
    4,                                  /* BIT_XOR */
    3,                                  /* BIT_OR */
    2,                                  /* AND */
    1,                                  /* OR */
    11, 11, 11                          /* UNARY_MINUS, NOT, BIT_NOT */
};
 
/*
 *----------------------------------------------------------------------
 *
 * ExprGetNum --
 *
 *      Parse off a number from a string.
 *
 * Results:
 *      The return value is the integer value corresponding to the
 *      leading digits of string.  If termPtr isn't NULL, *termPtr
 *      is filled in with the address of the character after the
 *      last one that is part of the number.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
ExprGetNum(string, termPtr)
    register char *string;              /* ASCII representation of number.
                                         * If leading digit is "0" then read
                                         * in base 8;  if "0x", then read in
                                         * base 16. */
    register char **termPtr;            /* If non-NULL, fill in with address
                                         * of terminating character. */
{
    int result, sign;
    register char c;

    c = *string;
    result = 0;
    if (c == '-') {
        sign = -1;
        string++; c = *string;
    } else {
        sign = 1;
    }
    if (c == '0') {
        string++; c = *string;
        if (c == 'x') {
            while (1) {
                string++; c = *string;
                if ((c >= '0') && (c <= '9')) {
                    result = (result << 4) + (c - '0');
                } else if ((c >= 'a') && (c <= 'f')) {
                    result = (result << 4) + 10 + (c - 'a');
                } else if ((c >= 'A') && (c <= 'F')) {
                    result = (result << 4) + 10 + (c - 'A');
                } else {
                    break;
                }
            }
        } else {
            while ((c >= '0') && (c <= '7')) {
                result = (result << 3) + (c - '0');
                string++;  c = *string;
            }
        }
    } else {
        while ((c >= '0') && (c <= '9')) {
            result = (result*10) + (c - '0');
            string++;  c = *string;
        }
    }
    if (termPtr != NULL) {
        *termPtr = string;
    }
    return result*sign;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ExprLex --
 *
 *      Lexical analyzer for expression parser.
 *
 * Results:
 *      TCL_OK is returned unless an error occurred while doing lexical
 *      analysis or executing an embedded command.  In that case a
 *      standard Tcl error is returned, using interp->result to hold
 *      an error message.  In the event of a successful return, the token
 *      and (possibly) number fields in infoPtr are updated to refer to
 *      the next symbol in the expression string, and the expr field is
 *      advanced.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
ExprLex(interp, infoPtr)
    Tcl_Interp *interp;                 /* Interpreter to use for error
                                         * reporting. */
    register ExprInfo *infoPtr;         /* Describes the state of the parse. */
{
    register char *p, c;
    char *var, *term;
    int result;

    /*
     * The next token is either:
     * (a)      a variable name (indicated by a $ sign plus a variable
     *          name in the standard Tcl fashion);  lookup the value
     *          of the variable and return its numeric equivalent as a
     *          number.
     * (b)      an embedded command (anything between '[' and ']').
     *          Execute the command and convert its result to a number.
     * (c)      a series of decimal digits.  Convert it to a number.
     * (d)      space:  skip it.
     * (d)      an operator.  See what kind it is.
     */

    p = infoPtr->expr;
    c = *p;
    while (isspace(c)) {
        p++;  c = *p;
    }
    infoPtr->expr = p+1;
    if (!isascii(c)) {
        infoPtr->token = UNKNOWN;
        return TCL_OK;
    }
    switch (c) {
        case '0':
        case '1':
        case '2':
        case '3':
        case '4':
        case '5':
        case '6':
        case '7':
        case '8':
        case '9':
            infoPtr->token = NUMBER;
            infoPtr->number = ExprGetNum(p, &infoPtr->expr);
            return TCL_OK;

        case '$':
            infoPtr->token = NUMBER;
            var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
            if (var == '\0') {
                return TCL_ERROR;
            }
            if (((Interp *) infoPtr->interp)->noEval) {
                infoPtr->number = 0;
                return TCL_OK;
            }
            infoPtr->number = ExprGetNum(var, &term);
            if ((term == var) || (*term != 0)) {
                c = *infoPtr->expr;
                *infoPtr->expr = 0;
                Tcl_Return(interp, (char *) NULL, TCL_STATIC);
                sprintf(interp->result,
                        "variable \"%.50s\" contained non-numeric value \"%.50s\"",
                        p, var);
                *infoPtr->expr = c;
                return TCL_ERROR;
            }
            return TCL_OK;

        case '[':
            infoPtr->token = NUMBER;
            result = Tcl_Eval(infoPtr->interp, p+1, TCL_BRACKET_TERM,
                    &infoPtr->expr);
            if (result != TCL_OK) {
                return result;
            }
            infoPtr->expr++;
            if (((Interp *) infoPtr->interp)->noEval) {
                infoPtr->number = 0;
                Tcl_Return(interp, (char *) NULL, TCL_STATIC);
                return TCL_OK;
            }
            infoPtr->number = ExprGetNum(interp->result, &term);
            if ((term == interp->result) || (*term != 0)) {
                char string[200];
                infoPtr->expr[-1];
                infoPtr->expr[-1] = 0;
                sprintf(string, "command \"%.50s\" returned non-numeric result \"%.50s\"",
                        p+1, interp->result);
                infoPtr->expr[-1] = c;
                Tcl_Return(interp, string, TCL_VOLATILE);
                return TCL_ERROR;
            }
            Tcl_Return(interp, (char *) NULL, TCL_STATIC);
            return TCL_OK;

        case '(':
            infoPtr->token = OPEN_PAREN;
            return TCL_OK;

        case ')':
            infoPtr->token = CLOSE_PAREN;
            return TCL_OK;

        case '*':
            infoPtr->token = MULT;
            return TCL_OK;

        case '/':
            infoPtr->token = DIVIDE;
            return TCL_OK;

        case '%':
            infoPtr->token = MOD;
            return TCL_OK;

        case '+':
            infoPtr->token = PLUS;
            return TCL_OK;

        case '-':
            infoPtr->token = MINUS;
            return TCL_OK;

        case '<':
            switch (p[1]) {
                case '<':
                    infoPtr->expr = p+2;
                    infoPtr->token = LEFT_SHIFT;
                    break;
                case '=':
                    infoPtr->expr = p+2;
                    infoPtr->token = LEQ;
                    break;
                default:
                    infoPtr->token = LESS;
                    break;
            }
            return TCL_OK;

        case '>':
            switch (p[1]) {
                case '>':
                    infoPtr->expr = p+2;
                    infoPtr->token = RIGHT_SHIFT;
                    break;
                case '=':
                    infoPtr->expr = p+2;
                    infoPtr->token = GEQ;
                    break;
                default:
                    infoPtr->token = GREATER;
                    break;
            }
            return TCL_OK;

        case '=':
            if (p[1] == '=') {
                infoPtr->expr = p+2;
                infoPtr->token = EQUAL;
            } else {
                infoPtr->token = UNKNOWN;
            }
            return TCL_OK;

        case '!':
            if (p[1] == '=') {
                infoPtr->expr = p+2;
                infoPtr->token = NEQ;
            } else {
                infoPtr->token = NOT;
            }
            return TCL_OK;

        case '&':
            if (p[1] == '&') {
                infoPtr->expr = p+2;
                infoPtr->token = AND;
            } else {
                infoPtr->token = BIT_AND;
            }
            return TCL_OK;

        case '^':
            infoPtr->token = BIT_XOR;
            return TCL_OK;

        case '|':
            if (p[1] == '|') {
                infoPtr->expr = p+2;
                infoPtr->token = OR;
            } else {
                infoPtr->token = BIT_OR;
            }
            return TCL_OK;

        case '~':
            infoPtr->token = BIT_NOT;
            return TCL_OK;

        case 0:
            infoPtr->token = END;
            infoPtr->expr = p;
            return TCL_OK;

        default:
            infoPtr->expr = p+1;
            infoPtr->token = UNKNOWN;
            return TCL_OK;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * ExprGetValue --
 *
 *      Parse a "value" from the remainder of the expression in infoPtr.
 *
 * Results:
 *      Normally TCL_OK is returned.  The value of the parsed number is
 *      returned in infoPtr->number.  If an error occurred, then
 *      interp->result contains an error message and TCL_ERROR is returned.
 *
 * Side effects:
 *      Information gets parsed from the remaining expression, and the
 *      expr and token fields in infoPtr get updated.  Information is
 *      parsed until either the end of the expression is reached (null
 *      character or close paren), an error occurs, or a binary operator
 *      is encountered with precedence <= prec.  In any of these cases,
 *      infoPtr->token will be left pointing to the token AFTER the
 *      expression.
 *
 *----------------------------------------------------------------------
 */

int
ExprGetValue(interp, infoPtr, prec)
    Tcl_Interp *interp;                 /* Interpreter to use for error
                                         * reporting. */
    register ExprInfo *infoPtr;         /* Describes the state of the parse
                                         * just before the value (i.e. ExprLex
                                         * will be called to get first token
                                         * of value). */
    int prec;                           /* Treat any un-parenthesized operator
                                         * with precedence <= this as the end
                                         * of the expression. */
{
    Interp *iPtr = (Interp *) interp;
    int result, operator, operand;
    int gotOp;                          /* Non-zero means already lexed the
                                         * operator (while picking up value
                                         * for unary operator).  Don't lex
                                         * again. */

    /*
     * There are two phases to this procedure.  First, pick off an initial
     * value.  Then, parse (binary operator, value) pairs until done.
     */

    gotOp = 0;
    result = ExprLex(interp, infoPtr);
    if (result != TCL_OK) {
        return result;
    }
    if (infoPtr->token == OPEN_PAREN) {

        /*
         * Parenthesized sub-expression.
         */

        result = ExprGetValue(interp, infoPtr, -1);
        if (result != TCL_OK) {
            return result;
        }
        if (infoPtr->token != CLOSE_PAREN) {
            Tcl_Return(interp, (char *) NULL, TCL_STATIC);
            sprintf(interp->result,
                    "unmatched parentheses in expression \"%.50s\"",
                    infoPtr->originalExpr);
            return TCL_ERROR;
        }
    } else {
        if (infoPtr->token == MINUS) {
            infoPtr->token = UNARY_MINUS;
        }
        if (infoPtr->token >= UNARY_MINUS) {

            /*
             * Process unary operators.
             */

            operator = infoPtr->token;
            result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token]);
            if (result != TCL_OK) {
                return result;
            }
            switch (operator) {
                case UNARY_MINUS:
                    infoPtr->number = -infoPtr->number;
                    break;
                case NOT:
                    infoPtr->number = !infoPtr->number;
                    break;
                case BIT_NOT:
                    infoPtr->number = ~infoPtr->number;
                    break;
            }
            gotOp = 1;
        } else if (infoPtr->token != NUMBER) {
            goto syntaxError;
        }
    }

    /*
     * Got the first operand.  Now fetch (operator, operand) pairs.
     */

    if (!gotOp) {
        result = ExprLex(interp, infoPtr);
        if (result != TCL_OK) {
            return result;
        }
    }
    while (1) {
        operand = infoPtr->number;
        operator = infoPtr->token;
        if ((operator < MULT) || (operator >= UNARY_MINUS)) {
            if ((operator == END) || (operator == CLOSE_PAREN)) {
                return TCL_OK;
            } else {
                goto syntaxError;
            }
        }
        if (precTable[operator] <= prec) {
            return TCL_OK;
        }

        /*
         * If we're doing an AND or OR and the first operand already
         * determines the result, don't execute anything in the
         * second operand:  just parse.
         */

        if (((operator == AND) && !operand)
                || ((operator == OR) && operand)) {
            iPtr->noEval++;
            result = ExprGetValue(interp, infoPtr, precTable[operator]);
            iPtr->noEval--;
        } else {
            result = ExprGetValue(interp, infoPtr, precTable[operator]);
        }
        if (result != TCL_OK) {
            return result;
        }
        if ((infoPtr->token < MULT) && (infoPtr->token != NUMBER)
                && (infoPtr->token != END)
                && (infoPtr->token != CLOSE_PAREN)) {
            goto syntaxError;
        }
        switch (operator) {
            case MULT:
                infoPtr->number = operand * infoPtr->number;
                break;
            case DIVIDE:
                if (infoPtr->number == 0) {
                    Tcl_Return(interp, "divide by zero", TCL_STATIC);
                    return TCL_ERROR;
                }
                infoPtr->number = operand / infoPtr->number;
                break;
            case MOD:
                if (infoPtr->number == 0) {
                    Tcl_Return(interp, "divide by zero", TCL_STATIC);
                    return TCL_ERROR;
                }
                infoPtr->number = operand % infoPtr->number;
                break;
            case PLUS:
                infoPtr->number = operand + infoPtr->number;
                break;
            case MINUS:
                infoPtr->number = operand - infoPtr->number;
                break;
            case LEFT_SHIFT:
                infoPtr->number = operand << infoPtr->number;
                break;
            case RIGHT_SHIFT:
                infoPtr->number = operand >> infoPtr->number;
                break;
            case LESS:
                infoPtr->number = operand < infoPtr->number;
                break;
            case GREATER:
                infoPtr->number = operand > infoPtr->number;
                break;
            case LEQ:
                infoPtr->number = operand <= infoPtr->number;
                break;
            case GEQ:
                infoPtr->number = operand >= infoPtr->number;
                break;
            case EQUAL:
                infoPtr->number = operand == infoPtr->number;
                break;
            case NEQ:
                infoPtr->number = operand != infoPtr->number;
                break;
            case BIT_AND:
                infoPtr->number = operand & infoPtr->number;
                break;
            case BIT_XOR:
                infoPtr->number = operand ^ infoPtr->number;
                break;
            case BIT_OR:
                infoPtr->number = operand | infoPtr->number;
                break;
            case AND:
                infoPtr->number = operand && infoPtr->number;
                break;
            case OR:
                infoPtr->number = operand || infoPtr->number;
                break;
        }
    }

    syntaxError:
    Tcl_Return(interp, (char *) NULL, TCL_STATIC);
    sprintf(interp->result, "syntax error in expression \"%.50s\"",
            infoPtr->originalExpr);
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Expr --
 *
 *      Parse and evaluate an expression.
 *
 * Results:
 *      The return value is TCL_OK if the expression was correctly parsed;
 *      if there was a syntax error or some other error during parsing,
 *      then another Tcl return value is returned and Tcl_Result points
 *      to an error message.  If all went well, *valuePtr is filled in
 *      with the result corresponding to the expression string.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Expr(interp, string, valuePtr)
    Tcl_Interp *interp;         /* Intepreter to use for variables etc. */
    char *string;               /* Expression to evaluate. */
    int *valuePtr;              /* Where to store result of evaluation. */
{
    ExprInfo info;
    int result;

    info.interp = interp;
    info.originalExpr = string;
    info.expr = string;
    result = ExprGetValue(interp, &info, -1);
    if (result != TCL_OK) {
        return result;
    }
    if (info.token != END) {
        Tcl_Return(interp, (char *) NULL, TCL_STATIC);
        sprintf(interp->result, "syntax error in expression \"%.50s\"", string);
        return TCL_ERROR;
    }
    *valuePtr = info.number;
    return TCL_OK;
}