tclparseexpr.c

tcl是工具命令语言

static int
ParseUnaryExpr(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("unaryExpr", 12);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;
    
    lexeme = infoPtr->lexeme;
    if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
            || (lexeme == NOT)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the unary operator */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseUnaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

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

	PrependSubExprTokens(operator, 1, srcStart,
	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    } else {			/* must be a primaryExpr */
	code = ParsePrimaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParsePrimaryExpr --
 *
 *	This procedure parses a Tcl primary expression:
 *	primaryExpr ::= literal | varReference | quotedString |
 *			'[' command ']' | mathFuncCall | '(' condExpr ')'
 *
 * 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
ParsePrimaryExpr(infoPtr)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Interp *interp = parsePtr->interp;
    Tcl_Token *tokenPtr, *exprTokenPtr;
    Tcl_Parse nested;
    CONST char *dollarPtr, *stringStart, *termPtr, *src;
    int lexeme, exprIndex, firstIndex, numToMove, code;

    /*
     * We simply recurse on parenthesized subexpressions.
     */

    HERE("primaryExpr", 13);
    lexeme = infoPtr->lexeme;
    if (lexeme == OPEN_PAREN) {
	code = GetLexeme(infoPtr); /* skip over the '(' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseCondExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	if (infoPtr->lexeme != CLOSE_PAREN) {
	    LogSyntaxError(infoPtr, "looking for close parenthesis");
	    return TCL_ERROR;
	}
	code = GetLexeme(infoPtr); /* skip over the ')' */
	if (code != TCL_OK) {
	    return code;
	}
	return TCL_OK;
    }

    /*
     * Start a TCL_TOKEN_SUB_EXPR token for the primary.
     */

    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
	TclExpandTokenArray(parsePtr);
    }
    exprIndex = parsePtr->numTokens;
    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
    exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
    exprTokenPtr->start = infoPtr->start;
    parsePtr->numTokens++;

    /*
     * Process the primary then finish setting the fields of the
     * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
     * stored in "exprTokenPtr" in the code below since the token array
     * might be reallocated.
     */

    firstIndex = parsePtr->numTokens;
    switch (lexeme) {
    case LITERAL:
	/*
	 * Int or double number.
	 */
	
	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
	    TclExpandTokenArray(parsePtr);
	}
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_TEXT;
	tokenPtr->start = infoPtr->start;
	tokenPtr->size = infoPtr->size;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = infoPtr->size;
	exprTokenPtr->numComponents = 1;
	break;

    case DOLLAR:
	/*
	 * $var variable reference.
	 */
	
	dollarPtr = (infoPtr->next - 1);
	code = Tcl_ParseVarName(interp, dollarPtr,
	        (infoPtr->lastChar - dollarPtr), parsePtr, 1);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
	exprTokenPtr->numComponents =
	        (parsePtr->tokenPtr[firstIndex].numComponents + 1);
	break;
	
    case QUOTE:
	/*
	 * '"' string '"'
	 */
	
	stringStart = infoPtr->next;
	code = Tcl_ParseQuotedString(interp, infoPtr->start,
	        (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = termPtr;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (termPtr - exprTokenPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

	/*
	 * If parsing the quoted string resulted in more than one token,
	 * insert a TCL_TOKEN_WORD token before them. This indicates that
	 * the quoted string represents a concatenation of multiple tokens.
	 */

	if (exprTokenPtr->numComponents > 1) {
	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
		TclExpandTokenArray(parsePtr);
	    }
	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
	    numToMove = (parsePtr->numTokens - firstIndex);
	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
	            (size_t) (numToMove * sizeof(Tcl_Token)));
	    parsePtr->numTokens++;

	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	    exprTokenPtr->numComponents++;

	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = exprTokenPtr->start;
	    tokenPtr->size = exprTokenPtr->size;
	    tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
	}
	break;
	
    case OPEN_BRACKET:
	/*
	 * '[' command {command} ']'
	 */

	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
	    TclExpandTokenArray(parsePtr);
	}
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_COMMAND;
	tokenPtr->start = infoPtr->start;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;

	/*
	 * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
	 * to find their end, then throw away that parse information.
	 */
	
	src = infoPtr->next;
	while (1) {
	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
		    &nested) != TCL_OK) {
		parsePtr->term = nested.term;
		parsePtr->errorType = nested.errorType;
		parsePtr->incomplete = nested.incomplete;
		return TCL_ERROR;
	    }
	    src = (nested.commandStart + nested.commandSize);

	    /*
	     * This is equivalent to Tcl_FreeParse(&nested), but
	     * presumably inlined here for sake of runtime optimization
	     */

	    if (nested.tokenPtr != nested.staticTokens) {
		ckfree((char *) nested.tokenPtr);
	    }

	    /*
	     * Check for the closing ']' that ends the command substitution.
	     * It must have been the last character of the parsed command.
	     */

	    if ((nested.term < parsePtr->end) && (*nested.term == ']') 
		    && !nested.incomplete) {
		break;
	    }
	    if (src == parsePtr->end) {
		if (parsePtr->interp != NULL) {
		    Tcl_SetResult(interp, "missing close-bracket",
			    TCL_STATIC);
		}
		parsePtr->term = tokenPtr->start;
		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
		parsePtr->incomplete = 1;
		return TCL_ERROR;
	    }
	}
	tokenPtr->size = (src - tokenPtr->start);
	infoPtr->next = src;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (src - tokenPtr->start);
	exprTokenPtr->numComponents = 1;
	break;

    case OPEN_BRACE:
	/*
	 * '{' string '}'
	 */

	code = Tcl_ParseBraces(interp, infoPtr->start,
	        (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
		&termPtr);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = termPtr;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (termPtr - infoPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

	/*
	 * If parsing the braced string resulted in more than one token,
	 * insert a TCL_TOKEN_WORD token before them. This indicates that
	 * the braced string represents a concatenation of multiple tokens.
	 */

	if (exprTokenPtr->numComponents > 1) {
	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
		TclExpandTokenArray(parsePtr);
	    }
	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
	    numToMove = (parsePtr->numTokens - firstIndex);
	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
	            (size_t) (numToMove * sizeof(Tcl_Token)));
	    parsePtr->numTokens++;

	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	    exprTokenPtr->numComponents++;
	    
	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = exprTokenPtr->start;
	    tokenPtr->size = exprTokenPtr->size;
	    tokenPtr->numComponents = exprTokenPtr->numComponents-1;
	}
	break;
	
    case FUNC_NAME:
	/*
	 * math_func '(' expr {',' expr} ')'
	 */
	
	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
	    TclExpandTokenArray(parsePtr);
	}
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_OPERATOR;
	tokenPtr->start = infoPtr->start;
	tokenPtr->size = infoPtr->size;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;
	
	code = GetLexeme(infoPtr); /* skip over function name */
	if (code != TCL_OK) {
	    return code;
	}
	if (infoPtr->lexeme != OPEN_PAREN) {
	    /*
	     * Guess what kind of error we have by trying to tell
	     * whether we have a function or variable name here.
	     * Alas, this makes the parser more tightly bound with the
	     * rest of the interpreter, but that is the only way to
	     * give a sensible message here.  Still, it is not too
	     * serious as this is only done when generating an error.
	     */
	    Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
	    Tcl_DString functionName;
	    Tcl_HashEntry *hPtr;

	    /*
	     * Look up the name as a function name.  We need a writable
	     * copy (DString) so we can terminate it with a NULL for
	     * the benefit of Tcl_FindHashEntry which operates on
	     * NULL-terminated string keys.
	     */
	    Tcl_DStringInit(&functionName);
	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, 
	    	Tcl_DStringAppend(&functionName, tokenPtr->start,
		tokenPtr->size));
	    Tcl_DStringFree(&functionName);

	    /*
	     * Assume that we have an attempted variable reference
	     * unless we've got a function name, as the set of
	     * potential function names is typically much smaller.
	     */
	    if (hPtr != NULL) {
		LogSyntaxError(infoPtr,
			"expected parenthesis enclosing function arguments");
	    } else {
		LogSyntaxError(infoPtr,
			"variable references require preceding $");
	    }
	    return TCL_ERROR;
	}
	code = GetLexeme(infoPtr); /* skip over '(' */
	if (code != TCL_OK) {
	    return code;
	}

	while (infoPtr->lexeme != CLOSE_PAREN) {
	    code = ParseCondExpr(infoPtr);
	    if (code != TCL_OK) {
		return code;
	    }
	    
	    if (infoPtr->lexeme == COMMA) {
		code = GetLexeme(infoPtr); /* skip over , */
		if (code != TCL_OK) {
		    return code;
		}
	    } else if (infoPtr->lexeme != CLOSE_PAREN) {
		LogSyntaxError(infoPtr,
			"missing close parenthesis at end of function call");
		return TCL_ERROR;
	    }
	}

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
	break;

    case COMMA:
	LogSyntaxError(infoPtr,
		"commas can only separate function arguments");
	return TCL_ERROR;
    case END:
	LogSyntaxError(infoPtr, "premature end of expression");
	return TCL_ERROR;
    case UNKNOWN:
	LogSyntaxError(infoPtr, "single equality character not legal in expressions");
	return TCL_ERROR;
    case UNKNOWN_CHAR:
	LogSyntaxError(infoPtr, "character not legal in expressions");
	return TCL_ERROR;
    case QUESTY:
	LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
	return TCL_ERROR;
    case COLON:
	LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
	return TCL_ERROR;
    case CLOSE_PAREN:
	LogSyntaxError(infoPtr, "unexpected close parenthesis");
	return TCL_ERROR;

    default: {
	char buf[64];

	sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
	LogSyntaxError(infoPtr, buf);
	return TCL_ERROR;
	}
    }

    /*
     * Advance to the next lexeme before returning.
     */
    
    code = GetLexeme(infoPtr);
    if (code != TCL_OK) {
	return code;
    }
    parsePtr->term = infoPtr->next;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetLexeme --
 *
 *	Lexical scanner for Tcl expressions: scans a single operator or
 *	other syntactic element from an expression string.
 *
 * Results:
 *	TCL_OK is returned unless an error occurred. In that case a standard
 *	Tcl error code is returned and, if infoPtr->parsePtr->interp is
 *	non-NULL, the interpreter's result is set to hold an error
 *	message. TCL_ERROR is returned if an integer overflow, or a
 *	floating-point overflow or underflow occurred while reading in a
 *	number. If the lexical analysis is successful, infoPtr->lexeme
 *	refers to the next symbol in the expression string, and
 *	infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
 *	LITERAL or FUNC_NAME, then infoPtr->start is set to the first
 *	character of the lexeme; otherwise it is set NULL.
 *
 * 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
GetLexeme(infoPtr)
    ParseInfo *infoPtr;		/* Holds state needed to parse the expr,
				 * including the resulting lexeme. */
{
    register CONST char *src;	/* Points to current source char. */
    char c;
    int offset, length, numBytes;
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Interp *interp = parsePtr->interp;
    Tcl_UniChar ch;

    /*
     * Record where the previous lexeme ended. Since we always read one
     * lexeme ahead during parsing, this helps us know the source length of
     * subexpression tokens.
     */

    infoPtr->prevEnd = infoPtr->next;

    /*
     * Scan over leading white space at the start of a lexeme. 
     */

    src = infoPtr->next;
    numBytes = parsePtr->end - src;
    do {
	char type;
	int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
	src += scanned; numBytes -= scanned;
    } while  (numBytes && (*src == '\n') && (src++,numBytes--));
    parsePtr->term = src;
    if (numBytes == 0) {
	infoPtr->lexeme = END;
	infoPtr->next = src;
	return TCL_OK;
    }

    /*
     * Try to parse the lexeme first as an integer or floating-point
     * number. Don't check for a number if the first character c is
     * "+" or "-". If we did, we might treat a binary operator as unary
     * by mistake, which would eventually cause a syntax error.
     */

    c = *src;
    if ((c != '+') && (c != '-')) {
	CONST char *end = infoPtr->lastChar;
	if ((length = TclParseInteger(src, (end - src)))) {
	    /*
	     * First length bytes look like an integer.  Verify by
	     * attempting the conversion to the largest integer we have.
	     */