/* 

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

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 * 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.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $

 */

#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 char *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.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C 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.

 *

 *----------------------------------------------------------------------

 */