Added [dict exists] compilation; implementation is 95% shared with [dict get].

7 files changed, 102 insertions, 17 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 9d2854d..5aa1e14 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -372,6 +372,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
     {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
     {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
+    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,1},
     {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
     {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
     {"dictIncrImm",	ASSEM_SINT4_LVT4,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 029606e..068848f 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -787,6 +787,42 @@ TclCompileDictGetCmd(
 }
 
 int
+TclCompileDictExistsCmd(
+    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. */
+{
+    Tcl_Token *tokenPtr;
+    int numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * There must be at least two arguments after the command (the single-arg
+     * case is legal, but too special and magic for us to deal with here).
+     */
+
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    numWords = parsePtr->numWords-1;
+
+    /*
+     * Now we do the code generation.
+     */
+
+    for (i=0 ; i<numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
+    return TCL_OK;
+}
+
+int
 TclCompileDictUnsetCmd(
     Tcl_Interp *interp,		/* Used for looking up stuff. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6e2cfae..128273b 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -434,6 +434,12 @@ InstructionDesc const tclInstructionTable[] = {
         /* Map variable contents back into a dictionary in the local variable
          * indicated by the LVT index. Part of [dict with].
 	 * Stack:  ... path keyList => ... */
+    {"dictExists",	 5,	INT_MIN,  1,	{OPERAND_UINT4}},
+	/* The top op4 words (min 1) are a key path into the dictionary just
+	 * below the keys on the stack, and all those values are replaced by a
+	 * boolean indicating whether it is possible to read out a value from
+	 * that key-path (like [dict exists]).
+	 * Stack:  ... dict key1 ... keyN => ... boolean */
 
     {"strmap",		 1,    -2,	  0,	{OPERAND_NONE}},
 	/* Simplified version of [string map] that only applies one change
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 2ea4209..24f9464 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -676,29 +676,30 @@ typedef struct ByteCode {
 #define INST_UNSET_ARRAY_STK		136
 #define INST_UNSET_STK			137
 
-/* For [dict with] compilation */
+/* For [dict with] and [dict exists] compilation */
 #define INST_DICT_EXPAND		138
 #define INST_DICT_RECOMBINE_STK		139
 #define INST_DICT_RECOMBINE_IMM		140
+#define INST_DICT_EXISTS		141
 
 /* For [string map] and [regsub] compilation */
-#define INST_STR_MAP			141
-#define INST_STR_FIND			142
-#define INST_STR_RANGE_IMM		143
+#define INST_STR_MAP			142
+#define INST_STR_FIND			143
+#define INST_STR_RANGE_IMM		144
 
 /* For operations to do with coroutines */
-#define INST_YIELD			144
-#define INST_COROUTINE_NAME		145
+#define INST_YIELD			145
+#define INST_COROUTINE_NAME		146
 
 /* For compilation of basic information operations */
-#define INST_NS_CURRENT			146
-#define INST_INFO_LEVEL_NUM		147
-#define INST_INFO_LEVEL_ARGS		148
-#define INST_RESOLVE_COMMAND		149
-#define INST_TCLOO_SELF			150
+#define INST_NS_CURRENT			147
+#define INST_INFO_LEVEL_NUM		148
+#define INST_INFO_LEVEL_ARGS		149
+#define INST_RESOLVE_COMMAND		150
+#define INST_TCLOO_SELF			151
 
 /* The last opcode */
-#define LAST_INST_OPCODE		150
+#define LAST_INST_OPCODE		151
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index ea9411c..2d6d209 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -87,16 +87,33 @@ static int		DictMapLoopCallback(ClientData data[],
  * Table of dict subcommand names and implementations.
  */
 
+#define NORMAL(name, term) \
+    {name, Dict##term##Cmd, NULL, NULL, NULL, 0}
+#define COMPILED(name, term) \
+    {name, Dict##term##Cmd, TclCompileDict##term##Cmd, NULL, NULL, 0}
+#define NR(name, term) \
+    {name, NULL, TclCompileDict##term##Cmd, Dict##term##NRCmd, NULL, 0}
 static const EnsembleImplMap implementationMap[] = {
+    COMPILED(	"append",	Append),
+    NORMAL(	"create",	Create),
+    COMPILED(	"exists",	Exists),
+    NORMAL(	"filter",	Filter),
+    NR(		"for",		For),
+    COMPILED(	"get",		Get),
+    COMPILED(	"incr",		Incr),
+    NORMAL(	"info",		Info),
+    NORMAL(	"keys",		Keys),
+    /*
     {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
     {"create",	DictCreateCmd, NULL, NULL, NULL, 0 },
-    {"exists",	DictExistsCmd, NULL, NULL, NULL, 0 },
+    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
     {"filter",	DictFilterCmd, NULL, NULL, NULL, 0 },
     {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
     {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
     {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
     {"info",	DictInfoCmd, NULL, NULL, NULL, 0 },
     {"keys",	DictKeysCmd, NULL, NULL, NULL, 0 },
+    */
     {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
     {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
     {"merge",	DictMergeCmd, NULL, NULL, NULL, 0 },
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 663d650..c6be2f3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5916,13 +5916,22 @@ TEBCresume(
 	DictUpdateInfo *duiPtr;
 
     case INST_DICT_GET:
+    case INST_DICT_EXISTS: {
+	register Tcl_Interp *interp2 = interp;
+
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
 	dictPtr = OBJ_AT_DEPTH(opnd);
+	if (*pc == INST_DICT_EXISTS) {
+	    interp2 = NULL;
+	}
 	if (opnd > 1) {
-	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
+	    dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1,
 		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
 	    if (dictPtr == NULL) {
+		if (*pc == INST_DICT_EXISTS) {
+		    goto dictNotExists;
+		}
 		TRACE_WITH_OBJ((
 			"%u => ERROR tracing dictionary path into \"%s\": ",
 			opnd, O2S(OBJ_AT_DEPTH(opnd))),
@@ -5930,8 +5939,13 @@ TEBCresume(
 		goto gotError;
 	    }
 	}
-	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
+	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
 		&objResultPtr) == TCL_OK) {
+	    if (*pc == INST_DICT_EXISTS) {
+		objResultPtr = TCONST(objResultPtr ? 1 : 0);
+		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		NEXT_INST_V(5, opnd+1, 1);
+	    }
 	    if (objResultPtr) {
 		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 		NEXT_INST_V(5, opnd+1, 1);
@@ -5945,11 +5959,18 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
 	} else {
+	    if (*pc == INST_DICT_EXISTS) {
+	    dictNotExists:
+		objResultPtr = TCONST(0);
+		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		NEXT_INST_V(5, opnd+1, 1);
+	    }
 	    TRACE_WITH_OBJ((
 		    "%u => ERROR reading leaf dictionary key \"%s\": ",
 		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
 	}
 	goto gotError;
+    }
 
     case INST_DICT_SET:
     case INST_DICT_UNSET:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9e9784b..3e2f548 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3502,10 +3502,10 @@ MODULE_SCOPE int	TclCompileContinueCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileDictAppendCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
+MODULE_SCOPE int	TclCompileDictExistsCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileDictMapCmd(Tcl_Interp *interp,
+MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
@@ -3517,6 +3517,9 @@ MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictMapCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileDictSetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);