* Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Contributions from Don Porter, NIST, 2006.  (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.73 2007/08/06 20:20:59 dgp Exp $
 * RCS: @(#) $Id: tclCompExpr.c,v 1.74 2007/08/10 14:02:17 dgp Exp $
 */

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

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

 * Tcl_Tokens.  These non-operator elements of the expression are the
 * leaves of the completed parse tree.  When an operand of an OpNode is
 * one of these leaf elements, the following negative integer codes are used
 * to indicate which kind of elements it is.
 */

enum OperandTypes {
    OT_NONE = -4,	/* Operand not yet (or no longer) known */
    OT_LITERAL = -3,	/* Operand is a literal in the literal list */
    OT_TOKENS = -2,	/* Operand is sequence of Tcl_Tokens */
    OT_EMPTY = -1	/* "Operand" is an empty string.  This is a
			 * special case used only to represent the
			 * EMPTY lexeme.  See below. */
};

    PREC_UNARY,		/* FUNCTION */
    PREC_START,		/* START */
    PREC_OPEN_PAREN,	/* OPEN_PAREN */
    PREC_UNARY,		/* NOT*/
    PREC_UNARY,		/* BIT_NOT*/
};

/*
 * A table mapping lexemes to bytecode instructions, used by CompileExprTree().
 */

static const unsigned char instruction[] = {
    /* 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,
    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,
    /* Binary operator lexemes */
    INST_ADD,		/* BINARY_PLUS */
    INST_SUB,		/* BINARY_MINUS */
    0,			/* COMMA */
    INST_MULT,		/* MULT */
    INST_DIV,		/* DIVIDE */
    INST_MOD,		/* MOD */
    INST_LT,		/* LESS */
    INST_GT,		/* GREATER */
    INST_BITAND,	/* BIT_AND */
    INST_BITXOR,	/* BIT_XOR */
    INST_BITOR,		/* BIT_OR */
    0,			/* QUESTION */
    0,			/* COLON */
    INST_LSHIFT,	/* LEFT_SHIFT */
    INST_RSHIFT,	/* RIGHT_SHIFT */
    INST_LE,		/* LEQ */
    INST_GE,		/* GEQ */
    INST_EQ,		/* EQUAL */
    INST_NEQ,		/* NEQ */
    0,			/* AND */
    0,			/* OR */
    INST_STR_EQ,	/* STREQ */
    INST_STR_NEQ,	/* STRNEQ */
    INST_EXPON,		/* EXPON */
    INST_LIST_IN,	/* IN_LIST */
    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*/
    INST_BITNOT,	/* BIT_NOT*/
};

/*
 * The JumpList struct is used to create a stack of data needed for the
 * 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.
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    Tcl_Obj *const litObjv[], Tcl_Obj *funcList,
			    Tcl_Token *tokenPtr, int *convertPtr,
			    CompileEnv *envPtr);
static void		ConvertTreeToTokens(const char *start, int numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		OpCmd(Tcl_Interp *interp, OpNode *nodes,
			    Tcl_Obj * const litObjv[]);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we
				 * need to know about it. */
    int incomplete;		/* Index of the most recent incomplete tree
				 * in the OpNode array.  Heads a stack of
				 * incomplete trees linked by p.prev. */
    int complete = OT_NONE;	/* "Index" of the complete tree (that is, a
    int complete = OT_EMPTY;	/* "Index" of the complete tree (that is, a
				 * complete subexpression) determined at the
				 * moment.   OT_NONE is a nonsense value
				 * moment.   OT_EMPTY is a nonsense value
				 * used only to silence compiler warnings.
				 * During a parse, complete will always hold
				 * an index or an OperandTypes value pointing
				 * to an actual leaf at the time the complete
				 * tree is needed. */

    /* These variables control generation of the error message. */

	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	goto error;
    }

    /* Initialize the parse tree with the special "START" node. */
    nodes->lexeme = START;
    nodes->precedence = prec[START];
    nodes->left = OT_NONE;
    nodes->right = OT_NONE;
    nodes->mark = MARK_RIGHT;
    incomplete = lastParsed = nodesUsed;
    nodesUsed++;

    /*
     * Main parsing loop parses one lexeme per iteration.  We exit the
     * loop only when there's a syntax error with a "goto error" which

		insertMark = 1;
		goto error;
	    }

	    /* Create an OpNode for the unary operator */
	    nodePtr->lexeme = lexeme;		/* Remember the operator... */
	    nodePtr->precedence = prec[lexeme];	/* ... and its precedence. */
	    nodePtr->left = OT_NONE;		/* No left operand */
	    nodePtr->right = OT_NONE;		/* Right operand not
						 * yet known. */
	    nodePtr->mark = MARK_RIGHT;

	    /*
	     * This unary operator is a new incomplete tree, so push it
	     * onto our stack of incomplete trees.  Also remember it as
	     * the last lexeme we parsed.
	     */

			 * We'll parse the ")" again the next time through,
			 * but with the OT_EMPTY leaf as the subexpression
			 * between the parens.
			 */

			scanned = 0;
			complete = lastParsed = OT_EMPTY;

			/* TODO: explain */
			nodePtr[-1].left--;
			break;
		    }
		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    goto error;
		}

	    if (lexeme == COMMA) {
		if  ((incompletePtr->lexeme != OPEN_PAREN)
			|| (incompletePtr[-1].lexeme != FUNCTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected \",\" outside function argument list");
		    goto error;
		}

		/* TODO: explain */
		incompletePtr->left++;
	    }

	    /* Operator ":" may only be right operand of "?" */
	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		goto error;
	    }

	    /* Create no node for a CLOSE_PAREN lexeme. */
	    if (lexeme == CLOSE_PAREN) {

		/* TODO: explain */
		incompletePtr->left++;
		break;
	    }

	    /* Link complete tree as left operand of new node. */
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->right = OT_NONE;
	    nodePtr->mark = MARK_LEFT;
	    nodePtr->left = complete;
	    if (IsOperator(complete)) {
		nodes[complete].p.parent = nodesUsed;
	    }

	    /*


/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into Tcl
 *	bytecodes. This procedure is the top-level interface to the the
 *	bytecodes. 
 *	expression compilation module, and is used by such public procedures
 *	as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong, Tcl_ExprDouble,
 *	Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *	on failure (which must be a syntax error). If TCL_ERROR is returned,
 *	then the interpreter's result contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

/* TODO: Convert this to return void.  Generate error throwing bytecode
 * for syntax errors instead of failing to compile. */
int
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{

    Tcl_Obj *const litObjv[],
    Tcl_Obj *funcList,
    Tcl_Token *tokenPtr,
    int *convertPtr,
    CompileEnv *envPtr)
{
    OpNode *nodePtr = nodes;
    int nextFunc = 0;
    int nextFunc = 0, numWords = 0;
    JumpList *freePtr, *jumpPtr = NULL;
    static const int instruction[] = {
	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,	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,		INST_ADD,	INST_SUB,	0, /* COMMA */
	INST_MULT,	INST_DIV,	INST_MOD,	INST_LT,
	INST_GT,	INST_BITAND,	INST_BITXOR,	INST_BITOR,
	0, /* QUESTION */	0, /* COLON */
	INST_LSHIFT,	INST_RSHIFT,	INST_LE,	INST_GE,
	INST_EQ,	INST_NEQ,	0, /* AND */	0, /* OR */
	INST_STR_EQ,	INST_STR_NEQ,	INST_EXPON,	INST_LIST_IN,
	INST_LIST_NOT_IN,	0, /* CLOSE_PAREN */	0, /* END */
	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,		INST_UPLUS,	INST_UMINUS,	0, /* FUNCTION */
	0, /* START */	0, /* OPEN_PAREN */
	INST_LNOT,	INST_BITNOT
    };

    while (1) {
	switch (NODE_TYPE & nodePtr->lexeme) {
	case UNARY:
	    if (nodePtr->right > OT_NONE) {
	    if (nodePtr->mark == MARK_RIGHT) {
		int right = nodePtr->right;

		nodePtr->right = OT_NONE;
		nodePtr->mark++;
		if (nodePtr->lexeme == FUNCTION) {
		    Tcl_DString cmdName;
		    Tcl_Obj *funcName;
		    const char *p;
		    int length;

		    Tcl_DStringInit(&cmdName);
		    Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		    Tcl_ListObjIndex(NULL, funcList, nextFunc++, &funcName);
		    p = Tcl_GetStringFromObj(funcName, &length);
		    Tcl_DStringAppend(&cmdName, p, length);
		    TclEmitPush(TclRegisterNewNSLiteral(envPtr,
			    Tcl_DStringValue(&cmdName),
			    Tcl_DStringLength(&cmdName)), envPtr);
		    Tcl_DStringFree(&cmdName);
		    /*
		     * Start a count of the number of words in this function
		     * command invocation.  In case there's already a count
		     * in progress (nested functions), save it in our unused
		     * "left" field for restoring later.
		     */
		    nodePtr->left = numWords;
		    numWords = 2;	/* Command plus one argument */
		}
		switch (right) {
		switch (nodePtr->right) {
		case OT_EMPTY:
		    numWords = 1;	/* No arguments, so just the command */
		    break;
		case OT_LITERAL:
		    /* TODO: reduce constant expressions */
		    TclEmitPush( TclAddLiteralObj(
			    envPtr, *litObjv++, NULL), envPtr);
		    break;
		case OT_TOKENS:
		    if (tokenPtr->type != TCL_TOKEN_WORD) {
			Tcl_Panic("unexpected token type %d\n",
				tokenPtr->type);
		    }
		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);
		    tokenPtr += tokenPtr->numComponents + 1;
		    break;
		default:
		    nodePtr = nodes + right;
		    nodePtr = nodes + nodePtr->right;
		}
	    } else {
		if (nodePtr->lexeme == START) {
		    /* We're done */
		    return;
		}
		if (nodePtr->lexeme == OPEN_PAREN) {
		    /* do nothing */
		} else if (nodePtr->lexeme == FUNCTION) {
		    /*
		     * Use the numWords count we've kept to invoke the
		     * function command with the correct number of arguments.
		     */
		    int numWords = (nodePtr[1].left - OT_NONE) + 1;
		
		    if (numWords < 255) {
			TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
		    } else {
			TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
		    }

		    /* Restore any saved numWords value. */
		    numWords = nodePtr->left;
		    *convertPtr = 1;
		} else {
		    TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		    *convertPtr = 0;
		}
		nodePtr = nodes + nodePtr->p.parent;
	    }
	    break;
	case BINARY:
	    if (nodePtr->left > OT_NONE) {
	    if (nodePtr->mark == MARK_LEFT) {
		int left = nodePtr->left;
		nodePtr->left = OT_NONE;
		nodePtr->mark++;
		/* TODO: reduce constant expressions */
		if (nodePtr->lexeme == QUESTION) {
		    JumpList *newJump = (JumpList *)
			    TclStackAlloc(interp, sizeof(JumpList));
		    newJump->next = jumpPtr;
		    jumpPtr = newJump;
		    newJump = (JumpList *)

		    jumpPtr = newJump;
		    newJump =  (JumpList *)
			    TclStackAlloc(interp, sizeof(JumpList));
		    newJump->next = jumpPtr;
		    jumpPtr = newJump;
		    jumpPtr->depth = envPtr->currStackDepth;
		}
		switch (left) {
		switch (nodePtr->left) {
		case OT_LITERAL:
		    TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL),
			    envPtr);
		    break;
		case OT_TOKENS:
		    if (tokenPtr->type != TCL_TOKEN_WORD) {
			Tcl_Panic("unexpected token type %d\n",
				tokenPtr->type);
		    }
		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);
		    tokenPtr += tokenPtr->numComponents + 1;
		    break;
		default:
		    nodePtr = nodes + left;
		    nodePtr = nodes + nodePtr->left;
		}
	    } else if (nodePtr->right > OT_NONE) {
		int right = nodePtr->right;
	    } else if (nodePtr->mark == MARK_RIGHT) {
		nodePtr->mark++;

		nodePtr->right = OT_NONE;
		if (nodePtr->lexeme == QUESTION) {
		    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
			    &(jumpPtr->jump));
		} else if (nodePtr->lexeme == COLON) {
		    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			    &(jumpPtr->next->jump));
		    envPtr->currStackDepth = jumpPtr->depth;
		    jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
		    jumpPtr->convert = *convertPtr;
		    *convertPtr = 1;
		} else if (nodePtr->lexeme == AND) {
		    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
			    &(jumpPtr->jump));
		} else if (nodePtr->lexeme == OR) {
		    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
			    &(jumpPtr->jump));
		}
		switch (right) {
		switch (nodePtr->right) {
		case OT_LITERAL:
		    TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL),
			    envPtr);
		    break;
		case OT_TOKENS:
		    if (tokenPtr->type != TCL_TOKEN_WORD) {
			Tcl_Panic("unexpected token type %d\n",
				tokenPtr->type);
		    }
		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);
		    tokenPtr += tokenPtr->numComponents + 1;
		    break;
		default:
		    nodePtr = nodes + right;
		    nodePtr = nodes + nodePtr->right;
		}
	    } else {
		if (nodePtr->lexeme == COMMA || nodePtr->lexeme == QUESTION) {
		if (nodePtr->lexeme == QUESTION) {
		    /* do nothing */
		} else if (nodePtr->lexeme == COMMA) {
		    /* Each comma implies another function argument. */
		    numWords++;
		} else if (nodePtr->lexeme == COLON) {
		    if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
			    (envPtr->codeNext - envPtr->codeStart)
			    - jumpPtr->next->jump.codeOffset, 127)) {
			jumpPtr->offset += 3;
		    }
		    TclFixupForwardJump(envPtr, &(jumpPtr->jump),

    if (objc != 1+occdPtr->numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }

    ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL);
    nodes[0].lexeme = START;
    nodes[0].mark = MARK_RIGHT;
    nodes[0].right = 1;
    nodes[1].lexeme = lexeme;
    if (objc == 2) {
	nodes[1].mark = MARK_RIGHT;
    } else {
	nodes[1].mark = MARK_LEFT;
    nodes[1].left = OT_LITERAL;
	nodes[1].left = OT_LITERAL;
    }
    nodes[1].right = OT_LITERAL;
    nodes[1].p.parent = 0;

    return OpCmd(interp, nodes, objv+1);
}

int

	int i, lastAnd = 1;

	ParseLexeme(occdPtr->operator, strlen(occdPtr->operator),
		&lexeme, NULL);

	litObjv[0] = objv[1];
	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	for (i=2; i<objc-1; i++) {
	    litObjv[2*(i-1)-1] = objv[i];
	    nodes[2*(i-1)-1].lexeme = lexeme;
	    nodes[2*(i-1)-1].mark = MARK_LEFT;
	    nodes[2*(i-1)-1].left = OT_LITERAL;
	    nodes[2*(i-1)-1].right = OT_LITERAL;

	    litObjv[2*(i-1)] = objv[i];
	    nodes[2*(i-1)].lexeme = AND;
	    nodes[2*(i-1)].mark = MARK_LEFT;
	    nodes[2*(i-1)].left = lastAnd;
	    nodes[lastAnd].p.parent = 2*(i-1);

	    nodes[2*(i-1)].right = 2*(i-1)+1;
	    nodes[2*(i-1)+1].p.parent= 2*(i-1);

	    lastAnd = 2*(i-1);
	}
	litObjv[2*(objc-2)-1] = objv[objc-1];

	nodes[2*(objc-2)-1].lexeme = lexeme;
	nodes[2*(objc-2)-1].mark = MARK_LEFT;
	nodes[2*(objc-2)-1].left = OT_LITERAL;
	nodes[2*(objc-2)-1].right = OT_LITERAL;

	nodes[0].right = lastAnd;
	nodes[lastAnd].p.parent = 0;

	code = OpCmd(interp, nodes, litObjv);

	if (lexeme == EXPON) {
	    litObjv[1] = Tcl_NewIntObj(occdPtr->numArgs);
	    Tcl_IncrRefCount(litObjv[1]);
	    decrMe = 1;
	    litObjv[0] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	} else {
	    if (lexeme == DIVIDE) {
		litObjv[0] = Tcl_NewDoubleObj(1.0);
	    } else {
		litObjv[0] = Tcl_NewIntObj(occdPtr->numArgs);
	    }
	    Tcl_IncrRefCount(litObjv[0]);
	    litObjv[1] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	}

	code = OpCmd(interp, nodes, litObjv);

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
		(objc-1)*sizeof(OpNode));
	int i, lastOp = OT_LITERAL;

	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	if (lexeme == EXPON) {
	    for (i=objc-2; i>0; i-- ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = OT_LITERAL;
		nodes[i].right = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		lastOp = i;
	    }
	} else {
	    for (i=1; i<objc-1; i++ ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		nodes[i].right = OT_LITERAL;
		lastOp = i;
	    }