/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions
 *	and implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (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: tclCompExpr.c,v 1.97.2.1 2010/01/06 21:35:25 nijtmans Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr().  It takes a

 * Each OpNode in the tree represents an operator in the expression, either
 * unary or binary.  When parsing is completed successfully, a binary operator
 * OpNode will have its left and right fields filled with "pointers" to its
 * left and right operands.  A unary operator OpNode will have its right field
 * filled with a pointer to its single operand.  When an operand is a
 * subexpression the "pointer" takes the form of the index -- a non-negative
 * integer -- into the OpNode storage array where the root of that
 * subexpression parse tree is found.  
 *
 * Non-operator elements of the expression do not get stored in the OpNode
 * tree.  They are stored in the other structures according to their type.
 * Literal values get appended to the literal list.  Elements that denote
 * forms of quoting or substitution known to the Tcl parser get stored as
 * Tcl_Tokens.  These non-operator elements of the expression are the
 * leaves of the completed parse tree.  When an operand of an OpNode is

				 * tree, and one operand should be parsed for
				 * it in the expression. */
#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
				 * tree.  No OpNode will be placed in the tree
				 * for it.  Either a literal value will be
				 * appended to the list of literals in this
				 * expression, or appropriate Tcl_Tokens will
				 * be appended in a Tcl_Parse struct to 
				 * represent those leaves that require some
				 * form of substitution.
				 */

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous.  Resolves to UNARY_PLUS or

    PREC_MULT,		/* "*", "/", "%" */
    PREC_EXPON,		/* "**" */
    PREC_UNARY		/* "+", "-", FUNCTION, "!", "~" */
};

/*
 * Here the same information contained in the comments above is stored
 * in inverted form, so that given a lexeme, one can quickly look up 
 * its precedence value.
 */

static const unsigned char prec[] = {
    /* Non-operator lexemes */
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,

    PREC_EQUAL,		/* NOT_IN_LIST */
    PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
    PREC_END,		/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  
    /* Unary operator lexemes */
    PREC_UNARY,		/* UNARY_PLUS */
    PREC_UNARY,		/* UNARY_MINUS */
    PREC_UNARY,		/* FUNCTION */
    PREC_START,		/* START */
    PREC_OPEN_PAREN,	/* OPEN_PAREN */
    PREC_UNARY,		/* NOT*/

    INST_LIST_NOT_IN,	/* NOT_IN_LIST */
    0,			/* CLOSE_PAREN */
    0,			/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  
    /* Unary operator lexemes */
    INST_UPLUS,		/* UNARY_PLUS */
    INST_UMINUS,	/* UNARY_MINUS */
    0,			/* FUNCTION */
    0,			/* START */
    0,			/* OPEN_PAREN */
    INST_LNOT,		/* NOT*/

 * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
 * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and 
				 * TclFixupForwardJump(). */
    int depth;			/* Remember the currStackDepth of the
				 * CompileEnv here. */
    int offset;			/* Data used to compute jump lengths to pass
				 * to TclFixupForwardJump() */
    int convert;		/* Temporary storage used to compute whether
				 * numeric conversion will be needed following

				 * we build the parse tree. */
    int nodesAvailable = 64;	/* Initial size of the storage array.  This
				 * value establishes a minimum tree memory cost
				 * of only about 1 kibyte, and is large enough
				 * for most expressions to parse with no need
				 * for array growth and reallocation. */
    int nodesUsed = 0;		/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by 
				 * parsing routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was.  If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we

		goto error;
	    case BAREWORD:

		/*
		 * Most barewords in an expression are a syntax error.
		 * The exceptions are that when a bareword is followed by
		 * an open paren, it might be a function call, and when the
		 * bareword is a legal literal boolean value, we accept that 
		 * as well.
		 */

		if (start[scanned+TclParseAllWhiteSpace(
			start+scanned, numBytes-scanned)] == '(') {
		    lexeme = FUNCTION;

		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN: 
		/*
		 * TODO: Consider using a dict or hash to collapse all
		 * duplicate literals into a single representative value.
		 * (Like what is done with [split $s {}]).
		 * Pro:	~75% memory saving on expressions like
		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
		 *	to "pointer" cost only)

		 *	due to high-water mark nature of memory allocation.
		 */
		Tcl_ListObjAppendElement(NULL, litList, literal);
		complete = lastParsed = OT_LITERAL;
		start += scanned;
		numBytes -= scanned;
		continue;
	    
	    default:
		break;
	    }

	    /*
	     * Remaining LEAF cases may involve filling Tcl_Tokens, so
	     * make room for at least 2 more tokens.

		    insertMark = 1;
		}
		goto error;
	    }

	    /*
	     * Here is where the tree comes together.  At this point, we
	     * have a stack of incomplete trees corresponding to 
	     * substrings that are incomplete expressions, followed by
	     * a complete tree corresponding to a substring that is itself
	     * a complete expression, followed by the binary operator we have
	     * just parsed.  The incomplete trees can each be completed by
	     * adding a right operand.
	     *
	     * To illustrate with an example, when we parse the expression

	    /* Link complete tree as left operand of new node. */
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->mark = MARK_LEFT;
	    nodePtr->left = complete;

	    /* 
	     * The COMMA operator cannot be optimized, since the function
	     * needs all of its arguments, and optimization would reduce
	     * the number.  Other binary operators root constant expressions
	     * when both arguments are constant expressions.
	     */

	    nodePtr->constant = (lexeme != COMMA);

	 * Add a detailed quote from the bad expression, displaying and
	 * sometimes marking the precise location of the syntax error.
	 */

	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		((start - limit) < parsePtr->string) ? "" : "...",
		((start - limit) < parsePtr->string)
			? (start - parsePtr->string) : limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? scanned : limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? parsePtr->end - (start + scanned) : limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/* Next, append any postscript message. */
	if (post != NULL) {
	    Tcl_AppendToObj(msg, ";\n", -1);
	    Tcl_AppendObjToObj(msg, post);

	     * when the word has multiple elements, a TCL_TOKEN_WORD token
	     * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR
	     * always has only one element.  Wise or not, these are the
	     * rules the Tcl expr parser has followed, and for the sake
	     * of those few callers of Tcl_ParseExpr() we do not change
	     * them now.  Internally, we can do better.
	     */
	
	    int toCopy = tokenPtr->numComponents + 1;

	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {

		/*
		 * Single element word.  Copy tokens and convert the leading
		 * token to TCL_TOKEN_SUB_EXPR.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		memcpy(subExprTokenPtr, tokenPtr,
			(size_t) toCopy * sizeof(Tcl_Token));
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		parsePtr->numTokens += toCopy;
	    } else {

		/* 
		 * Multiple element word.  Create a TCL_TOKEN_SUB_EXPR
		 * token to lead, with fields initialized from the leading
		 * token, then copy entire set of word tokens.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy+1);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;

	    /* Generate tokens for the operator / subexpression... */
	    switch (nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/* 
		 * Historical practice has been to have no Tcl_Tokens for
		 * these operators.
		 */

		break;

	    default: {

		break;

	    default: {

		/*
		 * Before we leave this node/operator/subexpression for the
		 * last time, finish up its tokens....
		 * 
		 * Our current position scanning the string is where the
		 * substring for the subexpression ends.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;


/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into Tcl
 *	bytecodes. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *

		break;
	    case FUNCTION:

		/*
		 * Use the numWords count we've kept to invoke the
		 * function command with the correct number of arguments.
		 */
		
		if (numWords < 255) {
		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
		} else {
		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
		}

		/* Restore any saved numWords value. */

    return ExecConstantExprTree(interp, nodes, 0, &litObjv);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSortingOpCmd --
 *	Implements the commands: <, <=, >, >=, ==, eq 
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary number of arguments by computing the AND of the base
 * 	operator applied to all neighbor argument pairs.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *