tclparseexpr.c

tcl是工具命令语言

	PrependSubExprTokens(operator, 2, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitOrExpr --
 *
 *	This procedure parses a Tcl bitwise or expression:
 *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitOrExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitOrExpr", 4);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseBitXorExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }
    
    while (infoPtr->lexeme == BIT_OR) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '|' */
	if (code != TCL_OK) {
	    return code;
	}

	code = ParseBitXorExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	
	/*
	 * Generate tokens for the BITOR subexpression and the '|' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitXorExpr --
 *
 *	This procedure parses a Tcl bitwise exclusive or expression:
 *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitXorExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitXorExpr", 5);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseBitAndExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }
    
    while (infoPtr->lexeme == BIT_XOR) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '^' */
	if (code != TCL_OK) {
	    return code;
	}

	code = ParseBitAndExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	
	/*
	 * Generate tokens for the XOR subexpression and the '^' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitAndExpr --
 *
 *	This procedure parses a Tcl bitwise and expression:
 *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitAndExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitAndExpr", 6);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseEqualityExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }
    
    while (infoPtr->lexeme == BIT_AND) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '&' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseEqualityExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	
	/*
	 * Generate tokens for the BITAND subexpression and '&' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseEqualityExpr --
 *
 *	This procedure parses a Tcl equality (inequality) expression:
 *	equalityExpr ::= relationalExpr
 *		{('==' | '!=' | 'ne' | 'eq') relationalExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseEqualityExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("equalityExpr", 7);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseRelationalExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == EQUAL) || (lexeme == NEQ)
	    || (lexeme == STREQ) || (lexeme == STRNEQ)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseRelationalExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
	 * operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseRelationalExpr --
 *
 *	This procedure parses a Tcl relational expression:
 *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseRelationalExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, operatorSize, code;
    CONST char *srcStart, *operator;

    HERE("relationalExpr", 8);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseShiftExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
            || (lexeme == GEQ)) {
	operator = infoPtr->start;
	if ((lexeme == LEQ) || (lexeme == GEQ)) {
	    operatorSize = 2;
	} else {
	    operatorSize = 1;
	}
	code = GetLexeme(infoPtr); /* skip over the operator */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseShiftExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and the operator.
	 */

	PrependSubExprTokens(operator, operatorSize, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseShiftExpr --
 *
 *	This procedure parses a Tcl shift expression:
 *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseShiftExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("shiftExpr", 9);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseAddExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over << or >> */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseAddExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '<<' or '>>' operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseAddExpr --
 *
 *	This procedure parses a Tcl addition expression:
 *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseAddExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("addExpr", 10);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseMultiplyExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == PLUS) || (lexeme == MINUS)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over + or - */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseMultiplyExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '+' or '-' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseMultiplyExpr --
 *
 *	This procedure parses a Tcl multiply expression:
 *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseMultiplyExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("multiplyExpr", 11);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    code = ParseUnaryExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over * or / or % */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseUnaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and * or / or % operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseUnaryExpr --
 *
 *	This procedure parses a Tcl unary expression:
 *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the
 *	information about the subexpression, then additional space is
 *	malloc-ed.
 *
 *----------------------------------------------------------------------
 */