summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclAssembly.c1
-rw-r--r--generic/tclCompCmds.c36
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclCompile.h25
-rw-r--r--generic/tclDictObj.c19
-rw-r--r--generic/tclExecute.c25
-rw-r--r--generic/tclInt.h7
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);
generated by cgit v0.12 at 2024-11-02 00:23:02 (GMT)