/*
 * tclParseExpr.c --
 *
 *	This file contains functions 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.
 *
 * RCS: @(#) $Id: tclParseExpr.c,v 1.32 2005/12/19 19:03:17 dgp Exp $
 */

#include "tclInt.h"

/*
 * 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

/*
 * Exponentiation operator:
 */

#define EXPON		36

/*
 * List containment operators
 */

#define IN_LIST		37
#define NOT_IN_LIST	38

/*
 * Mapping from lexemes to strings; used for debugging messages. These entries
 * must match the order and number of the lexeme definitions above.
 */

static char *lexemeStrings[] = {
    "LITERAL", "FUNCNAME",
    "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
    "*", "/", "%", "+", "-",
    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
    "&", "^", "|", "&&", "||", "?", ":",
    "!", "~", "eq", "ne", "**", "in", "ni"
};

/*
 * Declarations for local functions to this file:
 */

static int		GetLexeme(ParseInfo *infoPtr);
static void		LogSyntaxError(ParseInfo *infoPtr,
			    CONST char *extraInfo);
static int		ParseAddExpr(ParseInfo *infoPtr);
static int		ParseBitAndExpr(ParseInfo *infoPtr);
static int		ParseBitOrExpr(ParseInfo *infoPtr);
static int		ParseBitXorExpr(ParseInfo *infoPtr);
static int		ParseCondExpr(ParseInfo *infoPtr);
static int		ParseEqualityExpr(ParseInfo *infoPtr);
static int		ParseLandExpr(ParseInfo *infoPtr);
static int		ParseLorExpr(ParseInfo *infoPtr);
static int		ParseMultiplyExpr(ParseInfo *infoPtr);
static int		ParsePrimaryExpr(ParseInfo *infoPtr);
static int		ParseRelationalExpr(ParseInfo *infoPtr);
static int		ParseShiftExpr(ParseInfo *infoPtr);
static int		ParseExponentialExpr(ParseInfo *infoPtr);
static int		ParseUnaryExpr(ParseInfo *infoPtr);
static void		PrependSubExprTokens(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 function parses the first Tcl expression in the
 *	string and returns information about the structure of the expression.
 *	This function is the top-level interface to the the expression parsing
 *	module. No more than numBytes bytes will be scanned.
 *
 *	Note that this parser is a LL(1) parser; the operator precedence rules
 *	are completely hard coded in the recursive structure of the parser
 *	itself.
 *
 * 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
 *	function returns TCL_OK then the caller must eventually invoke
 *	Tcl_FreeParse to release any additional space that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    CONST char *start,		/* Start of 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 = (start? strlen(start) : 0);
    }
#ifdef TCL_COMPILE_DEBUG
    if (traceParseExpr) {
	fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
		numBytes, start);
    }
#endif /* TCL_COMPILE_DEBUG */

    TclParseInit(interp, start, numBytes, parsePtr);

    /*
     * 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 = start;
    info.prevEnd = start;
    info.originalExpr = start;
    info.lastChar = (start + 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 function 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 function
 *	call since such a function would only return the result of calling
 *	ParseCondExpr. Other recursive-descent functions 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(
    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 function 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(
    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 function 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(
    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 function 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(
    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 function 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(
    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 function 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(
    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 function 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(
    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 == NOT_IN_LIST ||
	    lexeme == IN_LIST || 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 function 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(
    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 function 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(
    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 function 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(
    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 function parses a Tcl multiply expression:
 *	multiplyExpr ::= exponentialExpr {('*' | '/' | '%') exponentialExpr}
 *
 * 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(
    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 = ParseExponentialExpr(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 = ParseExponentialExpr(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;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseExponentialExpr --
 *
 *	This function parses a Tcl exponential expression:
 *	exponentialExpr ::= 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
ParseExponentialExpr(
    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("exponentiateExpr", 12);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseUnaryExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while (lexeme == EXPON) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr);	/* skip over ** */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseUnaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

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

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseUnaryExpr --
 *
 *	This function 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(
    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", 13);
    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 function 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(
    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", 14);
    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;

    case STREQ:
    case STRNEQ:
    case IN_LIST:
    case NOT_IN_LIST:
    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_Obj *errMsg, *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;
	    }

	    /*
	     * Either there's a math function without a (, or a variable name
	     * without a '$'.
	     */

	    errMsg = Tcl_NewStringObj( "syntax error in expression \"", -1 );
	    TclAppendLimitedToObj(errMsg, infoPtr->originalExpr,
		    (int) (infoPtr->lastChar - infoPtr->originalExpr),
		    63, NULL);
	    Tcl_AppendToObj(errMsg, "\": the word \"", -1);
	    Tcl_AppendToObj(errMsg, savedInfo.start, savedInfo.size);
	    Tcl_AppendToObj(errMsg,
		    "\" requires a preceding $ if it's a variable ", -1);
	    Tcl_AppendToObj(errMsg,
		    "or function arguments if it's a function", -1);
	    Tcl_SetObjResult(infoPtr->parsePtr->interp, errMsg);
	    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
	    infoPtr->parsePtr->term = infoPtr->start;
	    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(
    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_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;
	CONST char* end2;
	int code = TclParseNumber(NULL, NULL, NULL, src, (int)(end-src),
		&end2, TCL_PARSE_NO_WHITESPACE);

	if (code == TCL_OK) {
	    length = end2-src;
	    if (length > 0) {
		infoPtr->lexeme = LITERAL;
		infoPtr->start = src;
		infoPtr->size = length;
		infoPtr->next = (src + length);
		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;
	if ((infoPtr->lastChar - src)>1  &&  src[1]=='*') {
	    infoPtr->lexeme = EXPON;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	}
	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->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    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->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = STRNEQ;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else if ((src[1] == 'i') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = NOT_IN_LIST;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else {
	    goto checkFuncName;
	}

    case 'i':
	if ((src[1] == 'n') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = IN_LIST;
	    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;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PrependSubExprTokens --
 *
 *	This function 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(
    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 function 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(
    ParseInfo *infoPtr,		/* Holds the parse state for the expression
				 * being parsed. */
    CONST char *extraInfo)	/* String to provide extra information about
				 * the syntax error. */
{
    Tcl_Obj *result =
	    Tcl_NewStringObj("syntax error in expression \"", -1);

    TclAppendLimitedToObj(result, infoPtr->originalExpr,
	    (int)(infoPtr->lastChar - infoPtr->originalExpr), 63, NULL);
    Tcl_AppendStringsToObj(result, "\": ", extraInfo, NULL);
    Tcl_SetObjResult(infoPtr->parsePtr->interp, result);
    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
    infoPtr->parsePtr->term = infoPtr->start;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */