summaryrefslogtreecommitdiffstats
path: root/generic/tclParseExpr.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclParseExpr.c')
-rw-r--r--generic/tclParseExpr.c2083
1 files changed, 0 insertions, 2083 deletions
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
deleted file mode 100644
index e07b7e7..0000000
--- a/generic/tclParseExpr.c
+++ /dev/null
@@ -1,2083 +0,0 @@
-/*
- * tclParseExpr.c --
- *
- * This file contains procedures that parse Tcl expressions. They
- * do so in a general-purpose fashion that can be used for many
- * different purposes, including compilation, direct execution,
- * code analysis, etc.
- *
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-/*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use
- * the errno from tclExecute.c here.
- */
-
-#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#else
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-extern int errno; /* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
-
-/*
- * Boolean variable that controls whether expression parse tracing
- * is enabled.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static int traceParseExpr = 0;
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- * The ParseInfo structure holds state while parsing an expression.
- * A pointer to an ParseInfo record is passed among the routines in
- * this module.
- */
-
-typedef struct ParseInfo {
- Tcl_Parse *parsePtr; /* Points to structure to fill in with
- * information about the expression. */
- int lexeme; /* Type of last lexeme scanned in expr.
- * See below for definitions. Corresponds to
- * size characters beginning at start. */
- CONST char *start; /* First character in lexeme. */
- int size; /* Number of bytes in lexeme. */
- CONST char *next; /* Position of the next character to be
- * scanned in the expression string. */
- CONST char *prevEnd; /* Points to the character just after the
- * last one in the previous lexeme. Used to
- * compute size of subexpression tokens. */
- CONST char *originalExpr; /* Points to the start of the expression
- * originally passed to Tcl_ParseExpr. */
- CONST char *lastChar; /* Points just after last byte of expr. */
-} ParseInfo;
-
-/*
- * Definitions of the different lexemes that appear in expressions. The
- * order of these must match the corresponding entries in the
- * operatorStrings array below.
- *
- * Basic lexemes:
- */
-
-#define LITERAL 0
-#define FUNC_NAME 1
-#define OPEN_BRACKET 2
-#define OPEN_BRACE 3
-#define OPEN_PAREN 4
-#define CLOSE_PAREN 5
-#define DOLLAR 6
-#define QUOTE 7
-#define COMMA 8
-#define END 9
-#define UNKNOWN 10
-#define UNKNOWN_CHAR 11
-
-/*
- * Binary numeric operators:
- */
-
-#define MULT 12
-#define DIVIDE 13
-#define MOD 14
-#define PLUS 15
-#define MINUS 16
-#define LEFT_SHIFT 17
-#define RIGHT_SHIFT 18
-#define LESS 19
-#define GREATER 20
-#define LEQ 21
-#define GEQ 22
-#define EQUAL 23
-#define NEQ 24
-#define BIT_AND 25
-#define BIT_XOR 26
-#define BIT_OR 27
-#define AND 28
-#define OR 29
-#define QUESTY 30
-#define COLON 31
-
-/*
- * Unary operators. Unary minus and plus are represented by the (binary)
- * lexemes MINUS and PLUS.
- */
-
-#define NOT 32
-#define BIT_NOT 33
-
-/*
- * Binary string operators:
- */
-
-#define STREQ 34
-#define STRNEQ 35
-
-/*
- * Mapping from lexemes to strings; used for debugging messages. These
- * entries must match the order and number of the lexeme definitions above.
- */
-
-static CONST char *CONST lexemeStrings[] = {
- "LITERAL", "FUNCNAME",
- "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
- "*", "/", "%", "+", "-",
- "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
- "&", "^", "|", "&&", "||", "?", ":",
- "!", "~", "eq", "ne",
-};
-
-/*
- * Declarations for local procedures to this file:
- */
-
-static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
-static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
- CONST char *extraInfo));
-static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
- CONST char *end));
-static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
- int opBytes, CONST char *src, int srcBytes,
- int firstIndex, ParseInfo *infoPtr));
-
-/*
- * Macro used to debug the execution of the recursive descent parser used
- * to parse expressions.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-#define HERE(production, level) \
- if (traceParseExpr) { \
- fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
- (level), " ", (production), \
- lexemeStrings[infoPtr->lexeme], infoPtr->next); \
- }
-#else
-#define HERE(production, level)
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ParseExpr --
- *
- * Given a string, this procedure parses the first Tcl expression
- * in the string and returns information about the structure of
- * the expression. This procedure is the top-level interface to the
- * the expression parsing module. No more that numBytes bytes will
- * be scanned.
- *
- * Results:
- * The return value is TCL_OK if the command was parsed successfully
- * and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
- * then an error message is left in its result. On a successful return,
- * parsePtr is filled in with information about the expression that
- * was parsed.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the
- * information about the expression, then additional space is
- * malloc-ed. If the procedure returns TCL_OK then the caller must
- * eventually invoke Tcl_FreeParse to release any additional space
- * that was allocated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ParseExpr(interp, string, numBytes, parsePtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- CONST char *string; /* The source string to parse. */
- int numBytes; /* Number of bytes in string. If < 0, the
- * string consists of all bytes up to the
- * first null character. */
- Tcl_Parse *parsePtr; /* Structure to fill with information about
- * the parsed expression; any previous
- * information in the structure is
- * ignored. */
-{
- ParseInfo info;
- int code;
-
- if (numBytes < 0) {
- numBytes = (string? strlen(string) : 0);
- }
-#ifdef TCL_COMPILE_DEBUG
- if (traceParseExpr) {
- fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
- numBytes, string);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- parsePtr->commentStart = NULL;
- parsePtr->commentSize = 0;
- parsePtr->commandStart = NULL;
- parsePtr->commandSize = 0;
- parsePtr->numWords = 0;
- parsePtr->tokenPtr = parsePtr->staticTokens;
- parsePtr->numTokens = 0;
- parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
- parsePtr->string = string;
- parsePtr->end = (string + numBytes);
- parsePtr->interp = interp;
- parsePtr->term = string;
- parsePtr->incomplete = 0;
-
- /*
- * Initialize the ParseInfo structure that holds state while parsing
- * the expression.
- */
-
- info.parsePtr = parsePtr;
- info.lexeme = UNKNOWN;
- info.start = NULL;
- info.size = 0;
- info.next = string;
- info.prevEnd = string;
- info.originalExpr = string;
- info.lastChar = (string + numBytes); /* just after last char of expr */
-
- /*
- * Get the first lexeme then parse the expression.
- */
-
- code = GetLexeme(&info);
- if (code != TCL_OK) {
- goto error;
- }
- code = ParseCondExpr(&info);
- if (code != TCL_OK) {
- goto error;
- }
- if (info.lexeme != END) {
- LogSyntaxError(&info, "extra tokens at end of expression");
- goto error;
- }
- return TCL_OK;
-
- error:
- if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree((char *) parsePtr->tokenPtr);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseCondExpr --
- *
- * This procedure parses a Tcl conditional expression:
- * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
- *
- * Note that this is the topmost recursive-descent parsing routine used
- * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
- * call since such a procedure would only return the result of calling
- * ParseCondExpr. Other recursive-descent procedures that need to parse
- * complete expressions also call ParseCondExpr.
- *
- * 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
-ParseCondExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the
- * expression being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
- int firstIndex, numToMove, code;
- CONST char *srcStart;
-
- HERE("condExpr", 1);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseLorExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- if (infoPtr->lexeme == QUESTY) {
- /*
- * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
- * conditional expression, and a TCL_TOKEN_OPERATOR token for
- * the "?" operator. Note that these two tokens must be inserted
- * before the LOR operand tokens generated above.
- */
-
- 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 = srcStart;
-
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_OPERATOR;
- tokenPtr->start = infoPtr->start;
- tokenPtr->size = 1;
- tokenPtr->numComponents = 0;
-
- /*
- * Skip over the '?'.
- */
-
- code = GetLexeme(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Parse the "then" expression.
- */
-
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
- if (infoPtr->lexeme != COLON) {
- LogSyntaxError(infoPtr, "missing colon from ternary conditional");
- return TCL_ERROR;
- }
- code = GetLexeme(infoPtr); /* skip over the ':' */
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Parse the "else" expression.
- */
-
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Now set the size-related fields in the '?' subexpression token.
- */
-
- condTokenPtr = &parsePtr->tokenPtr[firstIndex];
- condTokenPtr->size = (infoPtr->prevEnd - srcStart);
- condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLorExpr --
- *
- * This procedure parses a Tcl logical or expression:
- * lorExpr ::= landExpr {'||' landExpr}
- *
- * 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
-ParseLorExpr(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("lorExpr", 2);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseLandExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == OR) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '||' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseLandExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the LOR subexpression and the '||' operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLandExpr --
- *
- * This procedure parses a Tcl logical and expression:
- * landExpr ::= bitOrExpr {'&&' bitOrExpr}
- *
- * 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
-ParseLandExpr(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("landExpr", 3);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseBitOrExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == AND) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '&&' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseBitOrExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the LAND subexpression and the '&&' operator.
- */
-
- 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.
- *
- *----------------------------------------------------------------------
- */
-
-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.
- */
-
- tokenizeLiteral:
- 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;
-
-/*
- * Disable attempt to support functions named "eq" or "ne". This
- * is unworkable in the Tcl 8.4.* releases. See Tcl Bugs 1971879
- * and 1201589.
- *
- case STREQ:
- case STRNEQ:
-*/
- case FUNC_NAME: {
- /*
- * math_func '(' expr {',' expr} ')'
- */
-
- ParseInfo savedInfo = *infoPtr;
-
- code = GetLexeme(infoPtr); /* skip over function name */
- if (code != TCL_OK) {
- return code;
- }
- if (infoPtr->lexeme != OPEN_PAREN) {
- int code;
- Tcl_DString functionName;
- Tcl_HashEntry *hPtr;
- Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
- Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);
-
- /* Check for boolean literals (true, false, yes, no, on, off) */
- Tcl_IncrRefCount(objPtr);
- code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
- Tcl_DecrRefCount(objPtr);
- if (code == TCL_OK) {
- *infoPtr = savedInfo;
- goto tokenizeLiteral;
- }
-
- /*
- * 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.
- */
-
- /*
- * 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,
- savedInfo.start, savedInfo.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;
- }
-
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_OPERATOR;
- tokenPtr->start = savedInfo.start;
- tokenPtr->size = savedInfo.size;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- 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.
- */
- 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;
- 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;
-}