tclparseexpr.c

tcl是工具命令语言

	    int code;
	    Tcl_WideInt wide;
	    Tcl_Obj *value = Tcl_NewStringObj(src, length);

	    Tcl_IncrRefCount(value);
	    code = Tcl_GetWideIntFromObj(interp, value, &wide);
	    Tcl_DecrRefCount(value);
	    if (code == TCL_ERROR) {
		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
		return TCL_ERROR;
	    }
            infoPtr->lexeme = LITERAL;
	    infoPtr->start = src;
	    infoPtr->size = length;
            infoPtr->next = (src + length);
	    parsePtr->term = infoPtr->next;
            return TCL_OK;
	} else if ((length = ParseMaxDoubleLength(src, end))) {
	    /*
	     * There are length characters that could be a double.
	     * Let strtod() tells us for sure.  Need a writable copy
	     * so we can set an terminating NULL to keep strtod from
	     * scanning too far.
	     */
	    char *startPtr, *termPtr;
	    double doubleValue;
	    Tcl_DString toParse;

	    errno = 0;
	    Tcl_DStringInit(&toParse);
	    startPtr = Tcl_DStringAppend(&toParse, src, length);
	    doubleValue = strtod(startPtr, &termPtr);
	    Tcl_DStringFree(&toParse);
	    if (termPtr != startPtr) {
		if (errno != 0) {
		    if (interp != NULL) {
			TclExprFloatError(interp, doubleValue);
		    }
		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
		    return TCL_ERROR;
		}
		
		/*
                 * startPtr was the start of a valid double, copied
		 * from src.
                 */
		
		infoPtr->lexeme = LITERAL;
		infoPtr->start = src;
		if ((termPtr - startPtr) > length) {
		    infoPtr->size = length;
		} else {
		    infoPtr->size = (termPtr - startPtr);
		}
		infoPtr->next = src + infoPtr->size;
		parsePtr->term = infoPtr->next;
		return TCL_OK;
	    }
	}
    }

    /*
     * Not an integer or double literal. Initialize the lexeme's fields
     * assuming the common case of a single character lexeme.
     */

    infoPtr->start = src;
    infoPtr->size = 1;
    infoPtr->next = src+1;
    parsePtr->term = infoPtr->next;
    
    switch (*src) {
	case '[':
	    infoPtr->lexeme = OPEN_BRACKET;
	    return TCL_OK;

        case '{':
	    infoPtr->lexeme = OPEN_BRACE;
	    return TCL_OK;

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

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

	case '$':
	    infoPtr->lexeme = DOLLAR;
	    return TCL_OK;

	case '\"':
	    infoPtr->lexeme = QUOTE;
	    return TCL_OK;

	case ',':
	    infoPtr->lexeme = COMMA;
	    return TCL_OK;

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

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

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

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

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

	case '?':
	    infoPtr->lexeme = QUESTY;
	    return TCL_OK;

	case ':':
	    infoPtr->lexeme = COLON;
	    return TCL_OK;

	case '<':
	    infoPtr->lexeme = LESS;
	    if ((infoPtr->lastChar - src) > 1) {
		switch (src[1]) {
		    case '<':
			infoPtr->lexeme = LEFT_SHIFT;
			infoPtr->size = 2;
			infoPtr->next = src+2;
			break;
		    case '=':
			infoPtr->lexeme = LEQ;
			infoPtr->size = 2;
			infoPtr->next = src+2;
			break;
		}
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

	case '>':
	    infoPtr->lexeme = GREATER;
	    if ((infoPtr->lastChar - src) > 1) {
		switch (src[1]) {
		    case '>':
			infoPtr->lexeme = RIGHT_SHIFT;
			infoPtr->size = 2;
			infoPtr->next = src+2;
			break;
		    case '=':
			infoPtr->lexeme = GEQ;
			infoPtr->size = 2;
			infoPtr->next = src+2;
			break;
		}
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

	case '=':
	    infoPtr->lexeme = UNKNOWN;
	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = EQUAL;
		infoPtr->size = 2;
		infoPtr->next = src+2;
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

	case '!':
	    infoPtr->lexeme = NOT;
	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = NEQ;
		infoPtr->size = 2;
		infoPtr->next = src+2;
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

	case '&':
	    infoPtr->lexeme = BIT_AND;
	    if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = AND;
		infoPtr->size = 2;
		infoPtr->next = src+2;
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

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

	case '|':
	    infoPtr->lexeme = BIT_OR;
	    if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = OR;
		infoPtr->size = 2;
		infoPtr->next = src+2;
	    }
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;

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

	case 'e':
	    if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = STREQ;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		parsePtr->term = infoPtr->next;
		return TCL_OK;
	    } else {
		goto checkFuncName;
	    }

	case 'n':
	    if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
		infoPtr->lexeme = STRNEQ;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		parsePtr->term = infoPtr->next;
		return TCL_OK;
	    } else {
		goto checkFuncName;
	    }

	default:
	checkFuncName:
	    length = (infoPtr->lastChar - src);
	    if (Tcl_UtfCharComplete(src, length)) {
		offset = Tcl_UtfToUniChar(src, &ch);
	    } else {
		char utfBytes[TCL_UTF_MAX];
		memcpy(utfBytes, src, (size_t) length);
		utfBytes[length] = '\0';
		offset = Tcl_UtfToUniChar(utfBytes, &ch);
	    }
	    c = UCHAR(ch);
	    if (isalpha(UCHAR(c))) {	/* INTL: ISO only. */
		infoPtr->lexeme = FUNC_NAME;
		while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
		    src += offset; length -= offset;
		    if (Tcl_UtfCharComplete(src, length)) {
			offset = Tcl_UtfToUniChar(src, &ch);
		    } else {
			char utfBytes[TCL_UTF_MAX];
			memcpy(utfBytes, src, (size_t) length);
			utfBytes[length] = '\0';
			offset = Tcl_UtfToUniChar(utfBytes, &ch);
		    }
		    c = UCHAR(ch);
		}
		infoPtr->size = (src - infoPtr->start);
		infoPtr->next = src;
		parsePtr->term = infoPtr->next;
		/*
		 * Check for boolean literals (true, false, yes, no, on, off)
		 */
		switch (infoPtr->start[0]) {
		case 'f':
		    if (infoPtr->size == 5 &&
			strncmp("false", infoPtr->start, 5) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    }
		    break;
		case 'n':
		    if (infoPtr->size == 2 &&
			strncmp("no", infoPtr->start, 2) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    }
		    break;
		case 'o':
		    if (infoPtr->size == 3 &&
			strncmp("off", infoPtr->start, 3) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    } else if (infoPtr->size == 2 &&
			strncmp("on", infoPtr->start, 2) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    }
		    break;
		case 't':
		    if (infoPtr->size == 4 &&
			strncmp("true", infoPtr->start, 4) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    }
		    break;
		case 'y':
		    if (infoPtr->size == 3 &&
			strncmp("yes", infoPtr->start, 3) == 0) {
			infoPtr->lexeme = LITERAL;
			return TCL_OK;
		    }
		    break;
		}
		return TCL_OK;
	    }
	    infoPtr->lexeme = UNKNOWN_CHAR;
	    return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclParseInteger --
 *
 *	Scans up to numBytes bytes starting at src, and checks whether
 *	the leading bytes look like an integer's string representation.
 *
 * Results:
 *	Returns 0 if the leading bytes do not look like an integer.
 *	Otherwise, returns the number of bytes examined that look
 *	like an integer.  This may be less than numBytes if the integer
 *	is only the leading part of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclParseInteger(string, numBytes)
    register CONST char *string;/* The string to examine. */
    register int numBytes;	/* Max number of bytes to scan. */
{
    register CONST char *p = string;

    /* Take care of introductory "0x" */
    if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
	int scanned;
	Tcl_UniChar ch;
	p+=2; numBytes -= 2;
 	scanned = TclParseHex(p, numBytes, &ch);
	if (scanned) {
	    return scanned + 2;
	}

	/* Recognize the 0 as valid integer, but x is left behind */
	return 1;
    }
    while (numBytes && isdigit(UCHAR(*p))) {	/* INTL: digit */
	numBytes--; p++;
    }
    if (numBytes == 0) {
        return (p - string);
    }
    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
        return (p - string);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseMaxDoubleLength --
 *
 *      Scans a sequence of bytes checking that the characters could
 *	be in a string rep of a double.
 *
 * Results:
 *	Returns the number of bytes starting with string, runing to, but
 *	not including end, all of which could be part of a string rep.
 *	of a double.  Only character identity is used, no actual
 *	parsing is done.
 *
 *	The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', 
 *	'.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x',  and 'X'.
 *	This covers the values "Inf" and "Nan" as well as the
 *	decimal and hexadecimal representations recognized by a
 *	C99-compliant strtod().
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseMaxDoubleLength(string, end)
    register CONST char *string;/* The string to examine. */
    CONST char *end;		/* Point to the first character past the end
				 * of the string we are examining. */
{
    CONST char *p = string;
    while (p < end) {
	switch (*p) {
	    case '0': case '1': case '2': case '3': case '4': case '5':
	    case '6': case '7': case '8': case '9': case 'A': case 'B':
	    case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
	    case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
	    case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
	    case '.': case '+': case '-':
		p++;
		break;
	    default:
		goto done;
	}
    }
    done:
    return (p - string);
}

/*
 *----------------------------------------------------------------------
 *
 * PrependSubExprTokens --
 *
 *	This procedure is called after the operands of an subexpression have
 *	been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
 *	the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
 *	These two tokens are inserted before the operand tokens.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold the new tokens,
 *	additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static void
PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
    CONST char *op;		/* Points to first byte of the operator
				 * in the source script. */
    int opBytes;		/* Number of bytes in the operator. */
    CONST char *src;		/* Points to first byte of the subexpression
				 * in the source script. */
    int srcBytes;		/* Number of bytes in subexpression's
				 * source. */
    int firstIndex;		/* Index of first token already emitted for
				 * operator's first (or only) operand. */
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Token *tokenPtr, *firstTokenPtr;
    int numToMove;

    if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
	TclExpandTokenArray(parsePtr);
    }
    firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
    tokenPtr = (firstTokenPtr + 2);
    numToMove = (parsePtr->numTokens - firstIndex);
    memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
            (size_t) (numToMove * sizeof(Tcl_Token)));
    parsePtr->numTokens += 2;
    
    tokenPtr = firstTokenPtr;
    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
    tokenPtr->start = src;
    tokenPtr->size = srcBytes;
    tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
    
    tokenPtr++;
    tokenPtr->type = TCL_TOKEN_OPERATOR;
    tokenPtr->start = op;
    tokenPtr->size = opBytes;
    tokenPtr->numComponents = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * LogSyntaxError --
 *
 *	This procedure is invoked after an error occurs when parsing an
 *	expression. It sets the interpreter result to an error message
 *	describing the error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the interpreter result to an error message describing the
 *	expression that was being parsed when the error occurred, and why
 *	the parser considers that to be a syntax error at all.
 *
 *----------------------------------------------------------------------
 */

static void
LogSyntaxError(infoPtr, extraInfo)
    ParseInfo *infoPtr;		/* Holds the parse state for the
				 * expression being parsed. */
    CONST char *extraInfo;	/* String to provide extra information
				 * about the syntax error. */
{
    int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
    char buffer[100];

    if (numBytes > 60) {
	sprintf(buffer, "syntax error in expression \"%.60s...\"",
		infoPtr->originalExpr);
    } else {
	sprintf(buffer, "syntax error in expression \"%.*s\"",
		numBytes, infoPtr->originalExpr);
    }
    Tcl_ResetResult(infoPtr->parsePtr->interp);
    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
	    buffer, ": ", extraInfo, (char *) NULL);
    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
    infoPtr->parsePtr->term = infoPtr->start;
}