/* 
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 *
 * 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.6.14.1 2002/02/05 02:21:58 wolfsuit Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * The stuff below is a bit of a hack so that this file can be used in

				 * to TclCompileExpr. */
    char *lastChar;		/* Points just after last byte of expr. */
    int hasOperators;		/* Set 1 if the expr has operators; 0 if
				 * expr is only a primary. If 1 after
				 * compiling an expr, a tryCvtToNumeric
				 * instruction is emitted to convert the
				 * primary to a number if possible. */
    int exprIsJustVarRef;	/* Set 1 if the expr consists of just a
				 * variable reference as in the expression
				 * of "if $b then...". Otherwise 0. If 1 the
				 * expr is compiled out-of-line in order to
				 * implement expr's 2 level substitution
				 * semantics properly. */
    int exprIsComparison;	/* Set 1 if the top-level operator in the
				 * expr is a comparison. Otherwise 0. If 1,
				 * because the operands might be strings,
				 * the expr is compiled out-of-line in order
				 * to implement expr's 2 level substitution
				 * semantics properly. */
} ExprInfo;

/*
 * Definitions of numeric codes representing each expression operator.
 * The order of these must match the entries in the operatorTable below.
 * Also the codes for the relational operators (OP_LESS, OP_GREATER, 
 * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.

 *	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.
 *
 *	envPtr->exprIsJustVarRef is set 1 if the expression consisted of
 *	a single variable reference as in the expression of "if $b then...".
 *	Otherwise it is set 0. This is used to implement Tcl's two level
 *	expression substitution semantics properly.
 *
 *	envPtr->exprIsComparison is set 1 if the top-level operator in the
 *	expr is a comparison. Otherwise it is set 0. If 1, because the
 *	operands might be strings, the expr is compiled out-of-line in order
 *	to implement expr's 2 level substitution semantics properly.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

int

     */

    info.interp = interp;
    info.parsePtr = &parse;
    info.expr = script;
    info.lastChar = (script + numBytes); 
    info.hasOperators = 0;
    info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
    info.exprIsComparison = 0;

    /*
     * Parse the expression then compile it.
     */

    code = Tcl_ParseExpr(interp, script, numBytes, &parse);
    if (code != TCL_OK) {

	 */
	
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }
    Tcl_FreeParse(&parse);

    done:
    envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
    envPtr->exprIsComparison = info.exprIsComparison;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeCompilation --

 *	subexpression at runtime.
 *
 * 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.
 *
 *	envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
 *	a single variable reference as in the expression of "if $b then...".
 *	Otherwise it is set 0. This is used to implement Tcl's two level
 *	expression substitution semantics properly.
 *
 *	envPtr->exprIsComparison is set 1 if the top-level operator in the
 *	subexpression is a comparison. Otherwise it is set 0. If 1, because
 *	the operands might be strings, the expr is compiled out-of-line in
 *	order to implement expr's 2 level substitution semantics properly.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the subexpression.
 *
 *----------------------------------------------------------------------
 */

static int

        case TCL_TOKEN_WORD:
	    code = TclCompileTokens(interp, tokenPtr+1,
	            tokenPtr->numComponents, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_TEXT:
	    if (tokenPtr->size > 0) {
		objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
	                tokenPtr->size, /*onHeap*/ 0);
	    } else {
		objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
	    }
	    TclEmitPush(objIndex, envPtr);
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_BS:
	    length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
		    buffer);
	    if (length > 0) {
		objIndex = TclRegisterLiteral(envPtr, buffer, length,
	                /*onHeap*/ 0);
	    } else {
		objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
	    }
	    TclEmitPush(objIndex, envPtr);
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_COMMAND:
	    code = TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, /*nested*/ 1, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_VARIABLE:
	    code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	    break;
	    
        case TCL_TOKEN_SUB_EXPR:
	    infoPtr->exprIsComparison = 0;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	    break;
	    

		code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
			envPtr, &endPtr);
		operator[tokenPtr->size] = (char) savedChar;
		if (code != TCL_OK) {
		    goto done;
		}
		tokenPtr = endPtr;
		infoPtr->exprIsJustVarRef = 0;
		infoPtr->exprIsComparison = 0;
		break;
	    }
	    operator[tokenPtr->size] = (char) savedChar;
	    opIndex = (int) Tcl_GetHashValue(hPtr);
	    opDescPtr = &(operatorTable[opIndex]);

	    /*

		    if (code != TCL_OK) {
			goto done;
		    }
		    tokenPtr += (tokenPtr->numComponents + 1);
		}
		TclEmitOpcode(opDescPtr->instruction, envPtr);
		infoPtr->hasOperators = 1;
		infoPtr->exprIsJustVarRef = 0;
		infoPtr->exprIsComparison =
		    (((opIndex >= OP_LESS) && (opIndex <= OP_NEQ))
			    || ((opIndex >= OP_STREQ) && (opIndex <= OP_STRNEQ)));
		break;
	    }
	    
	    /*
	     * The operator requires special treatment, and is either
	     * "+" or "-", or one of "&&", "||" or "?".
	     */

		    break;
		    
		default:
		    panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
		        opIndex);
	    } /* end switch on operator requiring special treatment */
	    infoPtr->hasOperators = 1;
	    infoPtr->exprIsJustVarRef = 0;
	    infoPtr->exprIsComparison = 0;
	    break;

        default:
	    panic("CompileSubExpr: unexpected token type %d\n",
	            tokenPtr->type);
    }

	    if (tokenPtr == afterSubexprPtr) {
		Tcl_ResetResult(interp);
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
		        "too few arguments for math function", -1);
		code = TCL_ERROR;
		goto done;
	    }
	    infoPtr->exprIsComparison = 0;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	}
	if (tokenPtr != afterSubexprPtr) {