Index: generic/tclCompExpr.c ================================================================== --- generic/tclCompExpr.c +++ generic/tclCompExpr.c @@ -181,10 +181,12 @@ /* Quoted string; "foo $bar [soom]" */ #define EMPTY (LEAF | 7) /* 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 */ #define UNARY_PLUS (UNARY | PLUS) #define UNARY_MINUS (UNARY | MINUS) @@ -279,11 +281,18 @@ * special coding in ParseExpr() make sure we * never put an actual CLOSE_PAREN node in the * 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 * the CLOSE_PAREN lexeme and END pairs with * START, in the same way that CLOSE_PAREN @@ -302,10 +311,12 @@ PREC_END = 1, /* END */ PREC_START, /* START */ PREC_CLOSE_PAREN, /* ")" */ PREC_OPEN_PAREN, /* "(" */ PREC_COMMA, /* "," */ + PREC_SEPARATOR, /* ";" */ + PREC_ASSIGN, /* "=" */ PREC_CONDITIONAL, /* "?", ":" */ PREC_OR, /* "||" */ PREC_AND, /* "&&" */ PREC_BIT_OR, /* "|" */ PREC_BIT_XOR, /* "^" */ @@ -359,12 +370,14 @@ PREC_EXPON, /* EXPON */ PREC_EQUAL, /* IN_LIST */ 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, /* Unary operator lexemes */ PREC_UNARY, /* UNARY_PLUS */ @@ -414,12 +427,14 @@ INST_EXPON, /* EXPON */ INST_LIST_IN, /* IN_LIST */ 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, /* Unary operator lexemes */ INST_UPLUS, /* UNARY_PLUS */ @@ -460,13 +475,13 @@ OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, 0 /* * or ** */, PLUS /* + */, 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 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */ SCRIPT /* [ */, INVALID /* \ */, @@ -729,10 +744,25 @@ * 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 (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 { Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", @@ -839,10 +869,11 @@ } 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. * (Like what is done with [split $s {}]). * Pro: ~75% memory saving on expressions like @@ -1171,10 +1202,15 @@ */ if (lexeme == EXPON) { break; } + + /* Right association rules for assignment. */ + if (lexeme == ASSIGN) { + break; + } /* * Special association rules for the conditional * operators. The "?" and ":" operators have equal * precedence, but must be linked up in sensible pairs. @@ -1249,10 +1285,20 @@ if ((incompletePtr->lexeme == QUESTION) || (incompletePtr->lexeme == FUNCTION)) { 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. * Transfer the parse tree to the caller and return. @@ -1905,16 +1951,25 @@ return 2; } *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 '!': if ((numBytes > 1) && (start[1] == '=')) { *lexemePtr = NEQ; @@ -2283,10 +2338,13 @@ */ nodePtr->left = numWords; numWords = 2; /* Command plus one argument */ break; + case SEPARATOR: + TclEmitOpcode(INST_POP, envPtr); + break; } case QUESTION: newJump = TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; @@ -2321,11 +2379,22 @@ case QUESTION: if (convert && (nodePtr == rootPtr)) { 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; case FUNCTION: /*