Rebase patch to trunk.

1 files changed, 75 insertions, 6 deletions

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 83bb883..682017b 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -183,6 +183,8 @@ enum Marks {
 				/* Used only for an empty argument list to a
 				 * function. Represents the empty string
 				 * within parens in the expression: rand() */
+#define VARNAME         (LEAF | 8)
+                                /* Bareword as varname target of assignment */
 
 /* Unary operator lexemes */
 
@@ -281,7 +283,14 @@ enum Marks {
 				 * parse tree. The sub-expression between
 				 * parens becomes the single argument of the
 				 * matching OPEN_PAREN unary operator. */
-#define END		(BINARY | 28)
+
+#define SEPARATOR	( BINARY | 29)
+#define ASSIGN		( BINARY | 30)
+				/* ASSIGN, like EXPON, is right
+				 * associative, and this distinction
+				 * is coded directly in ParseExpr() */
+
+#define END		(BINARY | 31)
 				/* This lexeme represents the end of the
 				 * string being parsed. Treating it as a
 				 * binary operator follows the same logic as
@@ -304,6 +313,8 @@ enum Precedence {
     PREC_CLOSE_PAREN,	/* ")" */
     PREC_OPEN_PAREN,	/* "(" */
     PREC_COMMA,		/* "," */
+    PREC_SEPARATOR,	/* ";" */
+    PREC_ASSIGN,	/* "=" */
     PREC_CONDITIONAL,	/* "?", ":" */
     PREC_OR,		/* "||" */
     PREC_AND,		/* "&&" */
@@ -361,8 +372,10 @@ static const unsigned char prec[] = {
     PREC_EQUAL,		/* NOT_IN_LIST */
     PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
     PREC_END,		/* END */
+    PREC_SEPARATOR,	/* SEPARATOR */
+    PREC_ASSIGN,	/* ASSIGN */
     /* 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,
     0,
@@ -416,8 +429,10 @@ static const unsigned char instruction[] = {
     INST_LIST_NOT_IN,	/* NOT_IN_LIST */
     0,			/* CLOSE_PAREN */
     0,			/* END */
+    0,			/* SEPARATOR */
+    0,			/* ASSIGN */
     /* 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,
     0,
@@ -462,9 +477,9 @@ static const unsigned char Lexeme[] = {
 	COMMA		/* , */,	MINUS		/* - */,
 	0		/* . */,	DIVIDE		/* / */,
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */
-	COLON		/* : */,	INVALID		/* ; */,
+	/*COLON*/0	/* : */,	SEPARATOR	/* ; */,
 	0		/* < or << or <= */,
-	0		/* == or INVALID */,
+	0		/* = or == */,
 	0		/* > or >> or >= */,
 	QUESTION	/* ? */,	INVALID		/* @ */,
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* A-M */
@@ -731,6 +746,21 @@ ParseExpr(
 		     */
 
 		    Tcl_ListObjAppendElement(NULL, funcList, literal);
+		} else if (start[scanned+TclParseAllWhiteSpace(
+			start+scanned, numBytes-scanned)] == ':' &&
+			   start[scanned+TclParseAllWhiteSpace(
+			start+scanned, numBytes-scanned)+1] == '=') {
+		    lexeme = VARNAME;
+
+		    /*
+		     * When we compile the expression we'll need the function
+		     * name, and there's no place in the parse tree to store
+		     * it, so we keep a separate list of all the function
+		     * names we've parsed in the order we found them.
+		     */
+
+		    //		    Tcl_ListObjAppendElement(NULL, funcList, literal);
+
 		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
 		    lexeme = BOOLEAN;
 		} else {
@@ -841,6 +871,7 @@ ParseExpr(
 	    switch (lexeme) {
 	    case NUMBER:
 	    case BOOLEAN:
+	    case VARNAME:
 		/*
 		 * TODO: Consider using a dict or hash to collapse all
 		 * duplicate literals into a single representative value.
@@ -1174,6 +1205,11 @@ ParseExpr(
 			break;
 		    }
 
+		    /* Right association rules for assignment. */
+		    if (lexeme == ASSIGN) {
+			break;
+		    }
+
 		    /*
 		     * Special association rules for the conditional
 		     * operators. The "?" and ":" operators have equal
@@ -1252,6 +1288,16 @@ ParseExpr(
 		    nodes[complete].constant = incompletePtr->constant;
 		}
 
+		/*
+		 * We declare all ASSIGN operators to be non-constant
+		 * expressions because we do not want to optimize their
+		 * variable-setting side effects out of existence.
+		 */
+
+		if (incompletePtr->lexeme == ASSIGN) {
+		    incompletePtr->constant = 0;
+		}
+
 		if (incompletePtr->lexeme == START) {
 		    /*
 		     * Completing the START tree indicates we're done.
@@ -1907,12 +1953,21 @@ ParseLexeme(
 	*lexemePtr = MULT;
 	return 1;
 
+    case ':':
+	if ((numBytes > 1) && (start[1] == '=')) {
+	    *lexemePtr = ASSIGN;
+	    return 2;
+	}
+	*lexemePtr = COLON;
+	return 1;
+
+	
     case '=':
 	if ((numBytes > 1) && (start[1] == '=')) {
 	    *lexemePtr = EQUAL;
 	    return 2;
 	}
-	*lexemePtr = INCOMPLETE;
+	*lexemePtr = ASSIGN;
 	return 1;
 
     case '!':
@@ -2282,6 +2337,9 @@ CompileExprTree(
 		nodePtr->left = numWords;
 		numWords = 2;	/* Command plus one argument */
 		break;
+	    case SEPARATOR:
+		TclEmitOpcode(INST_POP, envPtr);
+		break;
 	    }
 	    case QUESTION:
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
@@ -2320,7 +2378,18 @@ CompileExprTree(
 		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
 		}
 		break;
+	    case ASSIGN:
+		if (convert) {
+		    /*
+		     * Make sure we assign to a variable only values that
+		     * have been numerically normalized in the expr way.
+		     */
+		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+		}
+		TclEmitOpcode(INST_STORE_STK, envPtr);
+		break;
 	    case OPEN_PAREN:
+	    case SEPARATOR:
 
 		/* do nothing */
 		break;