A better technique for [list {*}blah]. Remove the INST_LIST_EXPANDED opcode (and the complex machinery associated with it) as as it is no longer needed.

1 files changed, 74 insertions, 60 deletions

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7f6b7d4..1572576 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -280,12 +280,11 @@ const InstructionDesc const tclInstructionTable[] = {
 	/* Binary exponentiation operator: push (stknext ** stktop) */
 
     /*
-     * NOTE: the stack effects of expandStkTop, invokeExpanded and
-     * listExpanded are wrong - but it cannot be done right at compile time,
-     * the stack effect is only known at run time. The value for both
-     * invokeExpanded and listExpanded are estimated better at compile time.
-     * See the comments further down in this file, where INST_INVOKE_EXPANDED
-     * and INST_LIST_EXPANDED are emitted.
+     * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong -
+     * but it cannot be done right at compile time, the stack effect is only
+     * known at run time. The value for invokeExpanded is estimated better at
+     * compile time.  See the comments further down in this file, where
+     * INST_INVOKE_EXPANDED is emitted.
      */
     {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
 	/* Start of command with {*} (expanded) arguments */
@@ -539,8 +538,6 @@ const InstructionDesc const tclInstructionTable[] = {
 	/* Concatenates the two lists at the top of the stack into a single
 	 * list and pushes that resulting list onto the stack.
 	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
-    {"listExpanded",	 1,	0,	  0,	{OPERAND_NONE}},
-	/* Construct a list from the words marked by the last 'expandStart' */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
@@ -559,6 +556,8 @@ static void		EnterCmdExtentData(CompileEnv *envPtr,
 			    int cmdNumber, int numSrcBytes, int numCodeBytes);
 static void		EnterCmdStartData(CompileEnv *envPtr,
 			    int cmdNumber, int srcOffset, int codeOffset);
+static Command *	FindCommandFromToken(Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr);
 static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
 static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1775,6 +1774,49 @@ TclWordKnownAtCompileTime(
 }
 
 /*
+ * ---------------------------------------------------------------------
+ *
+ * FindCommandFromToken --
+ *
+ *	A simple helper that looks up a command's compiler from its token.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static Command *
+FindCommandFromToken(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Namespace *namespacePtr)
+{
+    Tcl_DString ds;
+    Command *cmdPtr;
+
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return NULL;
+    }
+
+    /*
+     * We copy the string before trying to find the command by name. We used
+     * to modify the string in place, but this is not safe because the name
+     * resolution handlers could have side effects that rely on the unmodified
+     * string.
+     */
+
+    Tcl_DStringInit(&ds);
+    TclDStringAppendToken(&ds, &tokenPtr[1]);
+    cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds),
+	    namespacePtr, /*flags*/ 0);
+    if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
+	    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
+	cmdPtr = NULL;
+    }
+    Tcl_DStringFree(&ds);
+    return cmdPtr;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TclCompileScript --
@@ -1816,7 +1858,6 @@ TclCompileScript(
     Command *cmdPtr;
     Tcl_Token *tokenPtr;
     int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
-    Tcl_DString ds;
     /* TIP #280 */
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     int *wlines, wlineat, cmdLine, *clNext;
@@ -1826,8 +1867,6 @@ TclCompileScript(
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
     }
 
-    Tcl_DStringInit(&ds);
-
     if (numBytes < 0) {
 	numBytes = strlen(script);
     }
@@ -1877,15 +1916,9 @@ TclCompileScript(
 		parsePtr->commandStart - envPtr->source);
 
 	if (parsePtr->numWords > 0) {
-	    int expand = 0;	/* Set if there are dynamic expansions to
+	    int expand = 0;	/* Set to the relevant expansion instruction
+				 * if there are dynamic expansions to
 				 * handle */
-	    int expandIgnoredWords = 0;
-				/* The number of *apparent* words that we are
-				 * generating code from directly during
-				 * expansion processing. For [list {*}blah]
-				 * expansion, we set this to one because we
-				 * ignore the first word and generate code
-				 * directly. */
 
 	    /*
 	     * If not the first command, pop the previous command's result
@@ -1943,6 +1976,22 @@ TclCompileScript(
 		}
 	    }
 
+	    /*
+	     * If expansion was requested, check if the command declares that
+	     * it knows how to compile it. Note that if expansion is requested
+	     * for the first word, this check will fail as the token type will
+	     * inhibit it. (That check is done inside FindCommandFromToken.)
+	     * This is as it should be.
+	     */
+
+	    if (expand) {
+		cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr,
+			(Tcl_Namespace *) cmdNsPtr);
+		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+		    expand = 0;
+		}
+	    }
+
 	    envPtr->numCommands++;
 	    currCmdIndex = envPtr->numCommands - 1;
 	    lastTopLevelCmdIndex = currCmdIndex;
@@ -1991,7 +2040,7 @@ TclCompileScript(
 
 		    TclCompileTokens(interp, tokenPtr+1,
 			    tokenPtr->numComponents, envPtr);
-		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 			TclEmitInstInt4(INST_EXPAND_STKTOP,
 				envPtr->currStackDepth, envPtr);
 		    }
@@ -2006,24 +2055,10 @@ TclCompileScript(
 		 */
 
 		if ((wordIdx == 0) && !expand) {
-		    /*
-		     * We copy the string before trying to find the command by
-		     * name. We used to modify the string in place, but this
-		     * is not safe because the name resolution handlers could
-		     * have side effects that rely on the unmodified string.
-		     */
-
-		    TclDStringClear(&ds);
-		    TclDStringAppendToken(&ds, &tokenPtr[1]);
-
-		    cmdPtr = (Command *) Tcl_FindCommand(interp,
-			    Tcl_DStringValue(&ds),
-			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+		    cmdPtr = FindCommandFromToken(interp, tokenPtr,
+			    (Tcl_Namespace *) cmdNsPtr);
 
 		    if ((cmdPtr != NULL)
-			    && (cmdPtr->compileProc != NULL)
-			    && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION)
-			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
 			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
 			int code, savedNumCmds = envPtr->numCommands;
 			unsigned savedCodeNext =
@@ -2148,26 +2183,6 @@ TclCompileScript(
 				TclFetchLiteral(envPtr, objIndex), cmdPtr);
 		    }
 		} else {
-		    if (wordIdx == 0 && expand) {
-			TclDStringClear(&ds);
-			TclDStringAppendToken(&ds, &tokenPtr[1]);
-			cmdPtr = (Command *) Tcl_FindCommand(interp,
-				Tcl_DStringValue(&ds),
-				(Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
-			if ((cmdPtr != NULL) &&
-				(cmdPtr->compileProc == TclCompileListCmd)) {
-			    /*
-			     * Special case! [list] command can be expanded
-			     * directly provided the first word is not the
-			     * expanded one.
-			     */
-
-			    expand = INST_LIST_EXPANDED;
-			    expandIgnoredWords = 1;
-			    continue;
-			}
-		    }
-
 		    /*
 		     * Simple argument word of a command. We reach this if and
 		     * only if the command word was not compiled for whatever
@@ -2211,12 +2226,12 @@ TclCompileScript(
 		 * is being prepared and run, INST_EXPAND_STKTOP is not
 		 * stack-neutral in general.
 		 *
-		 * The opcodes that may be issued here (both assumed to be
-		 * non-zero) are INST_INVOKE_EXPANDED and INST_LIST_EXPANDED.
+		 * The opcode that may be issued here (assumed to be non-zero)
+		 * is INST_INVOKE_EXPANDED.
 		 */
 
 		TclEmitOpcode(expand, envPtr);
-		TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
+		TclAdjustStackDepth(1 - wordIdx, envPtr);
 	    } else if (wordIdx > 0) {
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
@@ -2292,7 +2307,6 @@ TclCompileScript(
 
     envPtr->numSrcBytes = p - script;
     TclStackFree(interp, parsePtr);
-    Tcl_DStringFree(&ds);
 }
 
 /*