Experimental compilation of the [dict with] subcommand. No tests yet, and not

yet certain that the added bytecode opcodes are correct; evaluation is still
needed (but the test suite does pass...)

8 files changed, 584 insertions, 223 deletions

diff --git a/ChangeLog b/ChangeLog
index 1bcaf49..c112d2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-10-02  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
+	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
+	compilation for the [dict with] subcommand, using parts factored out
+	from the interpreted version of the command.
+
 2011-09-29  Donal K. Fellows  <dkf@users.sf.net>
 
 	* tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 66c03ab..172a58d 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1234,6 +1234,185 @@ TclCompileDictLappendCmd(
     TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
     return TCL_OK;
 }
+
+int
+TclCompileDictWithCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    int i, range, varNameTmp, pathTmp, keysTmp, gotPath;
+    Tcl_Token *dictVarTokenPtr, *tokenPtr;
+    int savedStackDepth = envPtr->currStackDepth;
+    JumpFixup jumpFixup;
+
+    /*
+     * There must be at least one argument after the command and we must be in
+     * a procedure so we can have local temporaries.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse the command (trivially). Expect the following:
+     *   dict with <any (varName)> ?<any> ...? <literal>
+     */
+
+    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    tokenPtr = TokenAfter(dictVarTokenPtr);
+    for (i=3 ; i<parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Allocate local (unnamed, untraced) working variables.
+     */
+
+    gotPath = (parsePtr->numWords > 3);
+    varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    if (gotPath) {
+	pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    } else {
+	pathTmp = -1;
+    }
+    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+
+    /*
+     * Issue instructions. First, the part to expand the dictionary.
+     */
+
+    tokenPtr = dictVarTokenPtr;
+    CompileWord(envPtr, tokenPtr, interp, 0);
+    if (varNameTmp <= 255) {
+	TclEmitInstInt1(	INST_STORE_SCALAR1, varNameTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_STORE_SCALAR4, varNameTmp,	envPtr);
+    }
+    tokenPtr = TokenAfter(tokenPtr);
+    if (gotPath) {
+	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+	    CompileWord(envPtr, tokenPtr, interp, i-1);
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
+	if (pathTmp <= 255) {
+	    TclEmitInstInt1(	INST_STORE_SCALAR1, pathTmp,	envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_STORE_SCALAR4, pathTmp,	envPtr);
+	}
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+    TclEmitOpcode(		INST_LOAD_STK,			envPtr);
+    if (gotPath) {
+	if (pathTmp <= 255) {
+	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
+	}
+    } else {
+	PushLiteral(envPtr, "", 0);
+    }
+    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
+    if (keysTmp <= 255) {
+	TclEmitInstInt1(	INST_STORE_SCALAR1, keysTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_STORE_SCALAR4, keysTmp,	envPtr);
+    }
+    TclEmitOpcode(		INST_POP,			envPtr);
+
+    /*
+     * Now the body of the [dict with].
+     */
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
+
+    ExceptionRangeStarts(envPtr, range);
+    envPtr->currStackDepth++;
+    SetLineInformation(parsePtr->numWords-1);
+    CompileBody(envPtr, tokenPtr, interp);
+    envPtr->currStackDepth = savedStackDepth;
+    ExceptionRangeEnds(envPtr, range);
+
+    /*
+     * Now fold the results back into the dictionary in the OK case.
+     */
+
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    if (varNameTmp <= 255) {
+	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
+    }
+    if (gotPath) {
+	if (pathTmp <= 255) {
+	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
+	}
+    } else {
+	PushLiteral(envPtr, "", 0);
+    }
+    if (keysTmp <= 255) {
+	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
+    }
+    TclEmitOpcode(		INST_DICT_RECOMBINE,		envPtr);
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+    /*
+     * Now fold the results back into the dictionary in the exception case.
+     */
+
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
+    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    if (varNameTmp <= 255) {
+	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
+    }
+    if (parsePtr->numWords > 3) {
+	if (pathTmp <= 255) {
+	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
+	}
+    } else {
+	PushLiteral(envPtr, "", 0);
+    }
+    if (keysTmp <= 255) {
+	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
+    }
+    TclEmitOpcode(		INST_DICT_RECOMBINE,		envPtr);
+    TclEmitOpcode(		INST_RETURN_STK,		envPtr);
+
+    /*
+     * Prepare for the start of the next command.
+     */
+
+    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+    }
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index d96670c..b043fed 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -167,135 +167,135 @@ enum Marks {
 
 /* Leaf lexemes */
 
-#define NUMBER		( LEAF | 1)	/* For literal numbers */
-#define SCRIPT		( LEAF | 2)	/* Script substitution; [foo] */
-#define BOOLEAN		( LEAF | BAREWORD)	/* For literal booleans */
-#define BRACED		( LEAF | 4)	/* Braced string; {foo bar} */
-#define VARIABLE	( LEAF | 5)	/* Variable substitution; $x */
-#define QUOTED		( LEAF | 6)	/* 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 NUMBER		(LEAF | 1)
+				/* For literal numbers */
+#define SCRIPT		(LEAF | 2)
+				/* Script substitution; [foo] */
+#define BOOLEAN		(LEAF | BAREWORD)
+				/* For literal booleans */
+#define BRACED		(LEAF | 4)
+				/* Braced string; {foo bar} */
+#define VARIABLE	(LEAF | 5)
+				/* Variable substitution; $x */
+#define QUOTED		(LEAF | 6)
+				/* 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() */
 
 /* Unary operator lexemes */
 
-#define UNARY_PLUS	( UNARY | PLUS)
-#define UNARY_MINUS	( UNARY | MINUS)
-#define FUNCTION	( UNARY | BAREWORD)	/* This is a bit of "creative
-					 * interpretation" on the part of the
-					 * parser. A function call is parsed
-					 * into the parse tree according to
-					 * the perspective that the function
-					 * name is a unary operator and its
-					 * argument list, enclosed in parens,
-					 * is its operand. The additional
-					 * requirements not implied generally
-					 * by treatment as a unary operator --
-					 * for example, the requirement that
-					 * the operand be enclosed in parens
-					 * -- are hard coded in the relevant
-					 * portions of ParseExpr(). We trade
-					 * off the need to include such
-					 * exceptional handling in the code
-					 * against the need we would otherwise
-					 * have for more lexeme categories. */
-#define START		( UNARY | 4)	/* This lexeme isn't parsed from the
-					 * expression text at all. It
-					 * represents the start of the
-					 * expression and sits at the root of
-					 * the parse tree where it serves as
-					 * the start/end point of
-					 * traversals. */
-#define OPEN_PAREN	( UNARY | 5)	/* Another bit of creative
-					 * interpretation, where we treat "("
-					 * as a unary operator with the
-					 * sub-expression between it and its
-					 * matching ")" as its operand. See
-					 * CLOSE_PAREN below. */
-#define NOT		( UNARY | 6)
-#define BIT_NOT		( UNARY | 7)
+#define UNARY_PLUS	(UNARY | PLUS)
+#define UNARY_MINUS	(UNARY | MINUS)
+#define FUNCTION	(UNARY | BAREWORD)
+				/* This is a bit of "creative interpretation"
+				 * on the part of the parser. A function call
+				 * is parsed into the parse tree according to
+				 * the perspective that the function name is a
+				 * unary operator and its argument list,
+				 * enclosed in parens, is its operand. The
+				 * additional requirements not implied
+				 * generally by treatment as a unary operator
+				 * -- for example, the requirement that the
+				 * operand be enclosed in parens -- are hard
+				 * coded in the relevant portions of
+				 * ParseExpr(). We trade off the need to
+				 * include such exceptional handling in the
+				 * code against the need we would otherwise
+				 * have for more lexeme categories. */
+#define START		(UNARY | 4)
+				/* This lexeme isn't parsed from the
+				 * expression text at all. It represents the
+				 * start of the expression and sits at the
+				 * root of the parse tree where it serves as
+				 * the start/end point of traversals. */
+#define OPEN_PAREN	(UNARY | 5)
+				/* Another bit of creative interpretation,
+				 * where we treat "(" as a unary operator with
+				 * the sub-expression between it and its
+				 * matching ")" as its operand. See
+				 * CLOSE_PAREN below. */
+#define NOT		(UNARY | 6)
+#define BIT_NOT		(UNARY | 7)
 
 /* Binary operator lexemes */
 
-#define BINARY_PLUS	( BINARY |  PLUS)
-#define BINARY_MINUS	( BINARY |  MINUS)
-#define COMMA		( BINARY |  3)	/* The "," operator is a low
-					 * precedence binary operator that
-					 * separates the arguments in a
-					 * function call. The additional
-					 * constraint that this operator can
-					 * only legally appear at the right
-					 * places within a function call
-					 * argument list are hard coded within
-					 * ParseExpr().  */
-#define MULT		( BINARY |  4)
-#define DIVIDE		( BINARY |  5)
-#define MOD		( BINARY |  6)
-#define LESS		( BINARY |  7)
-#define GREATER		( BINARY |  8)
-#define BIT_AND		( BINARY |  9)
-#define BIT_XOR		( BINARY | 10)
-#define BIT_OR		( BINARY | 11)
-#define QUESTION	( BINARY | 12)	/* These two lexemes make up the */
-#define COLON		( BINARY | 13)	/* ternary conditional operator,
-					 * $x ? $y : $z . We treat them as two
-					 * binary operators to avoid another
-					 * lexeme category, and code the
-					 * additional constraints directly in
-					 * ParseExpr(). For instance, the
-					 * right operand of a "?" operator
-					 * must be a ":" operator. */
-#define LEFT_SHIFT	( BINARY | 14)
-#define RIGHT_SHIFT	( BINARY | 15)
-#define LEQ		( BINARY | 16)
-#define GEQ		( BINARY | 17)
-#define EQUAL		( BINARY | 18)
-#define NEQ		( BINARY | 19)
-#define AND		( BINARY | 20)
-#define OR		( BINARY | 21)
-#define STREQ		( BINARY | 22)
-#define STRNEQ		( BINARY | 23)
-#define EXPON		( BINARY | 24)	/* Unlike the other binary operators,
-					 * EXPON is right associative and this
-					 * distinction is coded directly in
-					 * ParseExpr(). */
-#define IN_LIST		( BINARY | 25)
-#define NOT_IN_LIST	( BINARY | 26)
-#define CLOSE_PAREN	( BINARY | 27)	/* By categorizing the CLOSE_PAREN
-					 * lexeme as a BINARY operator, the
-					 * normal parsing rules for binary
-					 * operators assure that a close paren
-					 * will not directly follow another
-					 * operator, and the machinery already
-					 * in place to connect operands to
-					 * operators according to precedence
-					 * performs most of the work of
-					 * matching open and close parens for
-					 * us. In the end though, a close
-					 * paren is not really a binary
-					 * operator, and some 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)	/* 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 pairs
-					 * with OPEN_PAREN. */
+#define BINARY_PLUS	(BINARY |  PLUS)
+#define BINARY_MINUS	(BINARY |  MINUS)
+#define COMMA		(BINARY |  3)
+				/* The "," operator is a low precedence binary
+				 * operator that separates the arguments in a
+				 * function call. The additional constraint
+				 * that this operator can only legally appear
+				 * at the right places within a function call
+				 * argument list are hard coded within
+				 * ParseExpr().  */
+#define MULT		(BINARY |  4)
+#define DIVIDE		(BINARY |  5)
+#define MOD		(BINARY |  6)
+#define LESS		(BINARY |  7)
+#define GREATER		(BINARY |  8)
+#define BIT_AND		(BINARY |  9)
+#define BIT_XOR		(BINARY | 10)
+#define BIT_OR		(BINARY | 11)
+#define QUESTION	(BINARY | 12)
+				/* These two lexemes make up the */
+#define COLON		(BINARY | 13)
+				/* ternary conditional operator, $x ? $y : $z.
+				 * We treat them as two binary operators to
+				 * avoid another lexeme category, and code the
+				 * additional constraints directly in
+				 * ParseExpr(). For instance, the right
+				 * operand of a "?" operator must be a ":"
+				 * operator. */
+#define LEFT_SHIFT	(BINARY | 14)
+#define RIGHT_SHIFT	(BINARY | 15)
+#define LEQ		(BINARY | 16)
+#define GEQ		(BINARY | 17)
+#define EQUAL		(BINARY | 18)
+#define NEQ		(BINARY | 19)
+#define AND		(BINARY | 20)
+#define OR		(BINARY | 21)
+#define STREQ		(BINARY | 22)
+#define STRNEQ		(BINARY | 23)
+#define EXPON		(BINARY | 24)
+				/* Unlike the other binary operators, EXPON is
+				 * right associative and this distinction is
+				 * coded directly in ParseExpr(). */
+#define IN_LIST		(BINARY | 25)
+#define NOT_IN_LIST	(BINARY | 26)
+#define CLOSE_PAREN	(BINARY | 27)
+				/* By categorizing the CLOSE_PAREN lexeme as a
+				 * BINARY operator, the normal parsing rules
+				 * for binary operators assure that a close
+				 * paren will not directly follow another
+				 * operator, and the machinery already in
+				 * place to connect operands to operators
+				 * according to precedence performs most of
+				 * the work of matching open and close parens
+				 * for us. In the end though, a close paren is
+				 * not really a binary operator, and some
+				 * 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)
+				/* 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
+				 * pairs with OPEN_PAREN. */
+
 /*
  * When ParseExpr() builds the parse tree it must choose which operands to
  * connect to which operators.  This is done according to operator precedence.
- * The greater an operator's precedence the greater claim it has to link to
- * an available operand.  The Precedence enumeration lists the precedence
- * values used by Tcl expression operators, from lowest to highest claim.
- * Each precedence level is commented with the operators that hold that
- * precedence.
+ * The greater an operator's precedence the greater claim it has to link to an
+ * available operand.  The Precedence enumeration lists the precedence values
+ * used by Tcl expression operators, from lowest to highest claim.  Each
+ * precedence level is commented with the operators that hold that precedence.
  */
 
 enum Precedence {
@@ -320,9 +320,9 @@ enum Precedence {
 };
 
 /*
- * 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.
+ * 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[] = {
@@ -599,7 +599,10 @@ ParseExpr(
 				 * actual leaf at the time the complete tree
 				 * is needed. */
 
-    /* These variables control generation of the error message. */
+    /*
+     * These variables control generation of the error message.
+     */
+
     Tcl_Obj *msg = NULL;	/* The error message. */
     Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
 				 * for the error message, supplying more
@@ -801,17 +804,19 @@ ParseExpr(
 	    }
 	}	/* Uncategorized lexemes */
 
-	/* Handle lexeme based on its category. */
-	switch (NODE_TYPE & lexeme) {
-
 	/*
-	 * Each LEAF results in either a literal getting appended to the
-	 * litList, or a sequence of Tcl_Tokens representing a Tcl word
-	 * getting appended to the parsePtr->tokens. No OpNode is filled for
-	 * this lexeme.
+	 * Handle lexeme based on its category.
 	 */
 
+	switch (NODE_TYPE & lexeme) {
 	case LEAF: {
+	    /*
+	     * Each LEAF results in either a literal getting appended to the
+	     * litList, or a sequence of Tcl_Tokens representing a Tcl word
+	     * getting appended to the parsePtr->tokens. No OpNode is filled
+	     * for this lexeme.
+	     */
+
 	    Tcl_Token *tokenPtr;
 	    const char *end = start;
 	    int wordIndex;
@@ -828,7 +833,10 @@ ParseExpr(
 		scanned = 0;
 		insertMark = 1;
 
-		/* Free any literal to avoid a memleak. */
+		/*
+		 * Free any literal to avoid a memleak.
+		 */
+
 		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
 		    Tcl_DecrRefCount(literal);
 		}
@@ -1027,7 +1035,10 @@ ParseExpr(
 		goto error;
 	    }
 
-	    /* Create an OpNode for the unary operator */
+	    /*
+	     * Create an OpNode for the unary operator.
+	     */
+
 	    nodePtr->lexeme = lexeme;
 	    nodePtr->precedence = prec[lexeme];
 	    nodePtr->mark = MARK_RIGHT;
@@ -1498,7 +1509,10 @@ ConvertTreeToTokens(
 
 	case OT_LITERAL:
 
-	    /* Skip any white space that comes before the literal */
+	    /*
+	     * Skip any white space that comes before the literal.
+	     */
+
 	    scanned = TclParseAllWhiteSpace(start, numBytes);
 	    start += scanned;
 	    numBytes -= scanned;
@@ -1581,7 +1595,10 @@ ConvertTreeToTokens(
 
 	default:
 
-	    /* Advance to the child node, which is an operator. */
+	    /*
+	     * Advance to the child node, which is an operator.
+	     */
+
 	    nodePtr = nodes + next;
 
 	    /*
@@ -1662,7 +1679,10 @@ ConvertTreeToTokens(
 	case MARK_RIGHT:
 	    next = nodePtr->right;
 
-	    /* Skip any white space that comes before the operator */
+	    /*
+	     * Skip any white space that comes before the operator.
+	     */
+
 	    scanned = TclParseAllWhiteSpace(start, numBytes);
 	    start += scanned;
 	    numBytes -= scanned;
@@ -1679,7 +1699,10 @@ ConvertTreeToTokens(
 	    case COMMA:
 	    case COLON:
 
-		/* No tokens for these lexemes -> nothing to do. */
+		/*
+		 * No tokens for these lexemes -> nothing to do.
+		 */
+
 		break;
 
 	    default:
@@ -1714,7 +1737,10 @@ ConvertTreeToTokens(
 
 	    case OPEN_PAREN:
 
-		/* Skip past matching close paren. */
+		/*
+		 * Skip past matching close paren.
+		 */
+
 		scanned = TclParseAllWhiteSpace(start, numBytes);
 		start += scanned;
 		numBytes -= scanned;
@@ -1723,7 +1749,7 @@ ConvertTreeToTokens(
 		numBytes -= scanned;
 		break;
 
-	    default: {
+	    default:
 
 		/*
 		 * Before we leave this node/operator/subexpression for the
@@ -1757,7 +1783,6 @@ ConvertTreeToTokens(
 		subExprTokenIdx = parentIdx;
 		break;
 	    }
-	    }
 
 	    /*
 	     * Since we're returning to parent, skip child handling code.
@@ -2009,6 +2034,7 @@ ParseLexeme(
 	     */
 	    if (literal->typePtr == &tclDoubleType) {
 		const char *p = start;
+
 		while (p < end) {
 		    if (!isalnum(UCHAR(*p++))) {
 			/*
@@ -2028,6 +2054,7 @@ ParseLexeme(
 		 */
 		goto number;
 	    }
+
 	    /*
 	     * Otherwise, fall through and parse the whole as a bareword.
 	     */
@@ -2290,22 +2317,22 @@ CompileExprTree(
 		break;
 	    }
 	    case QUESTION:
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
 		break;
 	    case COLON:
 		CLANG_ASSERT(jumpPtr);
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&(jumpPtr->next->jump));
+			&jumpPtr->next->jump);
 		envPtr->currStackDepth = jumpPtr->depth;
 		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
 		jumpPtr->convert = convert;
 		convert = 1;
 		break;
 	    case AND:
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
 		break;
 	    case OR:
-		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
+		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
 		break;
 	    }
 	} else {
@@ -2348,12 +2375,12 @@ CompileExprTree(
 		break;
 	    case COLON:
 		CLANG_ASSERT(jumpPtr);
-		if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
+		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
 			(envPtr->codeNext - envPtr->codeStart)
 			- jumpPtr->next->jump.codeOffset, 127)) {
 		    jumpPtr->offset += 3;
 		}
-		TclFixupForwardJump(envPtr, &(jumpPtr->jump),
+		TclFixupForwardJump(envPtr, &jumpPtr->jump,
 			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
 		convert |= jumpPtr->convert;
 		envPtr->currStackDepth = jumpPtr->depth + 1;
@@ -2369,18 +2396,18 @@ CompileExprTree(
 		CLANG_ASSERT(jumpPtr);
 		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
 			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
-			&(jumpPtr->next->jump));
+			&jumpPtr->next->jump);
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&(jumpPtr->next->next->jump));
-		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
-		if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
+			&jumpPtr->next->next->jump);
+		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
+		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
 		    jumpPtr->next->next->jump.codeOffset += 3;
 		}
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
-		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
+		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
 			127);
 		convert = 0;
 		envPtr->currStackDepth = jumpPtr->depth + 1;
@@ -2400,8 +2427,8 @@ CompileExprTree(
 		break;
 	    }
 	    if (nodePtr == rootPtr) {
-
 		/* We're done */
+
 		return;
 	    }
 	    nodePtr = nodes + nodePtr->p.parent;
@@ -2478,6 +2505,7 @@ CompileExprTree(
 		     * Don't generate a string rep, but if we have one
 		     * already, then use it to share via the literal table.
 		     */
+
 		    if (objPtr->bytes) {
 			Tcl_Obj *tableValue;
 
@@ -2486,7 +2514,10 @@ CompileExprTree(
 			tableValue = envPtr->literalArrayPtr[index].objPtr;
 			if ((tableValue->typePtr == NULL) &&
 				(objPtr->typePtr != NULL)) {
-			    /* Same intrep surgery as for OT_LITERAL */
+			    /*
+			     * Same intrep surgery as for OT_LITERAL.
+			     */
+
 			    tableValue->typePtr = objPtr->typePtr;
 			    tableValue->internalRep = objPtr->internalRep;
 			    objPtr->typePtr = NULL;
@@ -2511,6 +2542,7 @@ CompileExprTree(
  *----------------------------------------------------------------------
  *
  * TclSingleOpCmd --
+ *
  *	Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
  *	in the ::tcl::mathop namespace.  These commands have no
  *	extension to arbitrary arguments; they accept only exactly one
@@ -2537,7 +2569,7 @@ TclSingleOpCmd(
     OpNode nodes[2];
     Tcl_Obj *const *litObjv = objv + 1;
 
-    if (objc != 1+occdPtr->i.numArgs) {
+    if (objc != 1 + occdPtr->i.numArgs) {
 	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
 	return TCL_ERROR;
     }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 026503b..4b5d2bb 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -421,6 +421,16 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Make general variable cease to exist; unparsed variable name is
 	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
 
+    {"dictExpand",       1,    -1,        0,    {OPERAND_NONE}},
+        /* Probe into a dict and extract it (or a subdict of it) into
+         * variables with matched names. Produces list of keys bound as
+         * result. Part of [dict with].
+	 * Stack:  ... dict path => ... keyList */
+    {"dictRecombine",    1,    -3,        0,    {OPERAND_NONE}},
+        /* Map variable contents back into a dictionary in a variable. Part of
+         * [dict with].
+	 * Stack:  ... dictVarName path keyList => ... */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 45d50ea..0cd667c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -676,8 +676,11 @@ typedef struct ByteCode {
 #define INST_UNSET_ARRAY_STK		136
 #define INST_UNSET_STK			137
 
+#define INST_DICT_EXPAND		138
+#define INST_DICT_RECOMBINE		139
+
 /* The last opcode */
-#define LAST_INST_OPCODE		137
+#define LAST_INST_OPCODE		139
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 83fc3a6..5b7ca9b 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -103,7 +103,7 @@ static const EnsembleImplMap implementationMap[] = {
     {"unset",	DictUnsetCmd, NULL, NULL, NULL, 0 },
     {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd, NULL, NULL, 0 },
     {"values",	DictValuesCmd, NULL, NULL, NULL, 0 },
-    {"with",	DictWithCmd, NULL, NULL, NULL, 0 },
+    {"with",	DictWithCmd,	TclCompileDictWithCmd, NULL, NULL, 0 },
     {NULL, NULL, NULL, NULL, NULL, 0}
 };
 
@@ -3110,9 +3110,7 @@ DictWithCmd(
     Tcl_Obj *const *objv)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr;
-    Tcl_DictSearch s;
-    int done;
+    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
@@ -3127,39 +3125,13 @@ DictWithCmd(
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
-    if (objc > 3) {
-	dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
-		DICT_PATH_READ);
-	if (dictPtr == NULL) {
-	    return TCL_ERROR;
-	}
-    }
 
-    /*
-     * Go over the list of keys and write each corresponding value to a
-     * variable in the current context with the same name. Also keep a copy of
-     * the keys so we can write back properly later on even if the dictionary
-     * has been structurally modified.
-     */
-
-    if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
-	    &done) != TCL_OK) {
+    keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
+    if (keysPtr == NULL) {
 	return TCL_ERROR;
     }
-
-    TclNewObj(keysPtr);
     Tcl_IncrRefCount(keysPtr);
 
-    for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
-	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
-	if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    TclDecrRefCount(keysPtr);
-	    Tcl_DictObjDone(&s);
-	    return TCL_ERROR;
-	}
-    }
-
     /*
      * Execute the body, while making the invoking context available to the
      * loop body (TIP#280) and postponing the cleanup until later (NRE).
@@ -3183,8 +3155,8 @@ FinalizeDictWith(
     Tcl_Interp *interp,
     int result)
 {
-    Tcl_Obj **keyv, *leafPtr, *dictPtr, *valPtr;
-    int keyc, i, allocdict = 0;
+    Tcl_Obj **pathv;
+    int pathc;
     Tcl_InterpState state;
     Tcl_Obj *varName = data[0];
     Tcl_Obj *keysPtr = data[1];
@@ -3195,43 +3167,163 @@ FinalizeDictWith(
     }
 
     /*
+     * Save the result state; TDWF doesn't guarantee to not modify that on
+     * TCL_OK result.
+     */
+
+    state = Tcl_SaveInterpState(interp, result);
+    if (pathPtr != NULL) {
+	Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
+    } else {
+	pathc = 0;
+	pathv = NULL;
+    }
+
+    /*
+     * Pack from local variables back into the dictionary.
+     */
+
+    result = TclDictWithFinish(interp, varName, pathc, pathv, keysPtr);
+
+    /*
+     * Tidy up and return the real result (unless we had an error).
+     */
+
+    TclDecrRefCount(varName);
+    TclDecrRefCount(keysPtr);
+    if (pathPtr != NULL) {
+	TclDecrRefCount(pathPtr);
+    }
+    if (result != TCL_OK) {
+	Tcl_DiscardInterpState(state);
+	return TCL_ERROR;
+    }
+    return Tcl_RestoreInterpState(interp, state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictWithInit --
+ *
+ *	Part of the core of [dict with]. Pokes into a dictionary and converts
+ *	the mappings there into assignments to (presumably) local variables.
+ *	Returns a list of all the names that were mapped so that removal of
+ *	either the variable or the dictionary entry won't surprise us when we
+ *	come to stuffing everything back.
+ *
+ * Result:
+ *	List of mapped names, or NULL if there was an error.
+ *
+ * Side effects:
+ *	Assigns to variables, so potentially legion due to traces.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDictWithInit(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    int pathc,
+    Tcl_Obj *const pathv[])
+{
+    Tcl_DictSearch s;
+    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
+    int done;
+
+    if (pathc > 0) {
+	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
+		DICT_PATH_READ);
+	if (dictPtr == NULL) {
+	    return NULL;
+	}
+    }
+
+    /*
+     * Go over the list of keys and write each corresponding value to a
+     * variable in the current context with the same name. Also keep a copy of
+     * the keys so we can write back properly later on even if the dictionary
+     * has been structurally modified.
+     */
+
+    if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
+	    &done) != TCL_OK) {
+	return NULL;
+    }
+
+    TclNewObj(keysPtr);
+
+    for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
+	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
+	if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
+		TCL_LEAVE_ERR_MSG) == NULL) {
+	    TclDecrRefCount(keysPtr);
+	    Tcl_DictObjDone(&s);
+	    return NULL;
+	}
+    }
+
+    return keysPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictWithFinish --
+ *
+ *	Part of the core of [dict with]. Reassembles the piece of the dict (in
+ *	varName, location given by pathc/pathv) from the variables named in
+ *	the keysPtr argument. NB, does not try to preserve errors or manage
+ *	argument lifetimes.
+ *
+ * Result:
+ *	TCL_OK if we succeeded, or TCL_ERROR if we failed.
+ *
+ * Side effects:
+ *	Assigns to a variable, so potentially legion due to traces. Updates
+ *	the dictionary in the named variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDictWithFinish(
+    Tcl_Interp *interp,
+    Tcl_Obj *varName,
+    int pathc,
+    Tcl_Obj *const pathv[],
+    Tcl_Obj *keysPtr)
+{
+    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
+    int i, allocdict, keyc;
+    Tcl_Obj **keyv;
+
+    /*
      * If the dictionary variable doesn't exist, drop everything silently.
      */
 
     dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
     if (dictPtr == NULL) {
-	TclDecrRefCount(varName);
-	TclDecrRefCount(keysPtr);
-	if (pathPtr) {
-	    TclDecrRefCount(pathPtr);
-	}
-	return result;
+	return TCL_OK;
     }
 
     /*
      * Double-check that it is still a dictionary.
      */
 
-    state = Tcl_SaveInterpState(interp, result);
     if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
-	TclDecrRefCount(varName);
-	TclDecrRefCount(keysPtr);
-	if (pathPtr) {
-	    TclDecrRefCount(pathPtr);
-	}
-	Tcl_DiscardInterpState(state);
 	return TCL_ERROR;
     }
 
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
 	allocdict = 1;
+    } else {
+	allocdict = 0;
     }
 
-    if (pathPtr != NULL) {
-	Tcl_Obj **pathv;
-	int pathc;
-
+    if (pathc > 0) {
 	/*
 	 * Want to get to the dictionary which we will update; need to do
 	 * prepare-for-update de-sharing along the path *but* avoid generating
@@ -3241,26 +3333,19 @@ FinalizeDictWith(
 	 * perfectly efficient (but no memory should be leaked).
 	 */
 
-	Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
 	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
 		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
-	TclDecrRefCount(pathPtr);
 	if (leafPtr == NULL) {
-	    TclDecrRefCount(varName);
-	    TclDecrRefCount(keysPtr);
 	    if (allocdict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    Tcl_DiscardInterpState(state);
 	    return TCL_ERROR;
 	}
 	if (leafPtr == DICT_PATH_NON_EXISTENT) {
-	    TclDecrRefCount(varName);
-	    TclDecrRefCount(keysPtr);
 	    if (allocdict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    return Tcl_RestoreInterpState(interp, state);
+	    return TCL_OK;
 	}
     } else {
 	leafPtr = dictPtr;
@@ -3286,14 +3371,13 @@ FinalizeDictWith(
 	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
 	}
     }
-    TclDecrRefCount(keysPtr);
 
     /*
      * Ensure that none of the dictionaries in the chain still have a string
      * rep.
      */
 
-    if (pathPtr != NULL) {
+    if (pathc > 0) {
 	InvalidateDictChain(leafPtr);
     }
 
@@ -3303,11 +3387,12 @@ FinalizeDictWith(
 
     if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG) == NULL) {
-	Tcl_DiscardInterpState(state);
+	if (allocdict) {
+	    TclDecrRefCount(dictPtr);
+	}
 	return TCL_ERROR;
     }
-    TclDecrRefCount(varName);
-    return Tcl_RestoreInterpState(interp, state);
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 691c8d7..e3db83e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1992,9 +1992,8 @@ TclNRExecuteByteCode(
      * Push the callback for bytecode execution
      */
     
-    TclNRAddCallback(interp, TEBCresume, TD,
-	    /*resume*/ INT2PTR(0), NULL, NULL);
-    
+    TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
+	    NULL, NULL);
     return TCL_OK;
 }
 
@@ -5625,7 +5624,7 @@ TEBCresume(
 
     {
 	int opnd2, allocateDict, done, i, allocdict;
-	Tcl_Obj *dictPtr, *statePtr, *keyPtr;
+	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
 	Tcl_Obj *emptyPtr, **keyPtrPtr;
 	Tcl_DictSearch *searchPtr;
 	DictUpdateInfo *duiPtr;
@@ -6105,6 +6104,44 @@ TEBCresume(
 	    }
 	}
 	NEXT_INST_F(9, 1, 0);
+
+    case INST_DICT_EXPAND:
+	dictPtr = OBJ_UNDER_TOS;
+	listPtr = OBJ_AT_TOS;
+	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
+		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+	    goto gotError;
+	}
+	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
+	if (objResultPtr == NULL) {
+	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
+		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+	    goto gotError;
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, 1);
+
+    case INST_DICT_RECOMBINE:
+	varNamePtr = OBJ_AT_DEPTH(2);
+	listPtr = OBJ_UNDER_TOS;
+	keysPtr = OBJ_AT_TOS;
+	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	    TRACE_WITH_OBJ(("%.30s %.30s %.30s => ERROR: ",
+		    O2S(varNamePtr), O2S(listPtr), O2S(keysPtr)),
+		    Tcl_GetObjResult(interp));
+	    goto gotError;
+	}
+	if (TclDictWithFinish(interp, varNamePtr, objc, objv,
+		keysPtr) != TCL_OK) {
+	    TRACE_WITH_OBJ(("%.30s %.30s %.30s => ERROR: ",
+		    O2S(varNamePtr), O2S(listPtr), O2S(keysPtr)),
+		    Tcl_GetObjResult(interp));
+	    goto gotError;
+	}
+	TclDecrRefCount(keysPtr);
+	POP_OBJECT();
+	NEXT_INST_F(1, 2, 0);
     }
 
     /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f30e83e..e7a84ce 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3231,6 +3231,11 @@ MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp,
+			    Tcl_Obj *varName, int pathc,
+			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
+MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+			    int pathc, Tcl_Obj *const pathv[]);
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3495,6 +3500,9 @@ MODULE_SCOPE int	TclCompileDictSetCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileDictUpdateCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictWithCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileEnsemble(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);