diff options
| -rw-r--r-- | generic/tcl.h | 1 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 306 |
2 files changed, 247 insertions, 60 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 5f4a77a..3f9f06a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1363,7 +1363,6 @@ typedef struct { int epoch; /* Epoch marker for dictionary being searched, * or -1 if search has terminated. */ Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ - Tcl_Obj *resultList; /* List of result values from the loop body. */ } Tcl_DictSearch; /* diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 56baf1f..dac4cbe 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -76,13 +76,12 @@ static int FinalizeDictWith(ClientData data[], Tcl_Interp *interp, int result); static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictEachNRCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv, int collect); -static int DictEachLoopCallback(ClientData data[], +static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); +static int DictForLoopCallback(ClientData data[], + Tcl_Interp *interp, int result); +static int DictMapLoopCallback(ClientData data[], Tcl_Interp *interp, int result); - /* * Table of dict subcommand names and implementations. @@ -186,6 +185,23 @@ static const Tcl_HashKeyType chainHashType = { AllocChainEntry, TclFreeObjEntry }; + +/* + * Structure used in implementation of 'dict map' to hold the state that gets + * passed between parts of the implementation. + */ + +typedef struct { + Tcl_Obj *keyVarObj; /* The name of the variable that will have + * keys assigned to it. */ + Tcl_Obj *valueVarObj; /* The name of the variable that will have + * values assigned to it. */ + Tcl_DictSearch search; /* The dictionary search structure. */ + Tcl_Obj *scriptObj; /* The script to evaluate each time through + * the loop. */ + Tcl_Obj *accumulatorObj; /* The dictionary used to accumulate the + * results. */ +} DictMapStorage; /***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/ @@ -2338,11 +2354,11 @@ DictAppendCmd( /* *---------------------------------------------------------------------- * - * DictForNRCmd, DictMapNRCmd, DictEachNRCmd -- + * DictForNRCmd -- * - * These functions implement the "dict for" and "dict map" Tcl commands. - * See the user documentation for details on what it does, and TIP#111 - * and TIP#405 for the formal specification. + * These functions implement the "dict for" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2360,27 +2376,6 @@ DictForNRCmd( int objc, Tcl_Obj *const *objv) { - return DictEachNRCmd(dummy, interp, objc, objv, 0); -} - -static int -DictMapNRCmd( - ClientData dummy, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv) -{ - return DictEachNRCmd(dummy, interp, objc, objv, 1); -} - -static int -DictEachNRCmd( - ClientData dummy, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv, - int collect) /* Flag == 1 to collect and return loop body result. */ -{ Interp *iPtr = (Interp *) interp; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; @@ -2406,7 +2401,6 @@ DictEachNRCmd( return TCL_ERROR; } searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch)); - searchPtr->resultList = (collect ? Tcl_NewListObj(0, NULL) : NULL ); if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, searchPtr); @@ -2450,7 +2444,7 @@ DictEachNRCmd( * Run the script. */ - TclNRAddCallback(interp, DictEachLoopCallback, searchPtr, keyVarObj, + TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -2468,7 +2462,7 @@ DictEachNRCmd( } static int -DictEachLoopCallback( +DictForLoopCallback( ClientData data[], Tcl_Interp *interp, int result) @@ -2493,34 +2487,19 @@ DictEachLoopCallback( result = TCL_OK; } else if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - ((searchPtr->resultList == NULL) ? - "\n (\"dict for\" body line %d)" : - "\n (\"dict map\" body line %d)"), + "\n (\"dict for\" body line %d)", Tcl_GetErrorLine(interp))); } goto done; } /* - * Capture result if collecting. - */ - - if (searchPtr->resultList != NULL) { - Tcl_ListObjAppendElement(interp, searchPtr->resultList, Tcl_GetObjResult(interp)); - } - - /* * Get the next mapping from the dictionary. */ Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done); if (done) { - if (searchPtr->resultList != NULL) { - Tcl_SetObjResult(interp, searchPtr->resultList); - searchPtr->resultList = NULL; /* Don't clean it up */ - } else { - Tcl_ResetResult(interp); - } + Tcl_ResetResult(interp); goto done; } @@ -2530,13 +2509,15 @@ DictEachLoopCallback( */ Tcl_IncrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, + TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); result = TCL_ERROR; goto done; } TclDecrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; goto done; } @@ -2545,7 +2526,7 @@ DictEachLoopCallback( * Run the script. */ - TclNRAddCallback(interp, DictEachLoopCallback, searchPtr, keyVarObj, + TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -2553,12 +2534,9 @@ DictEachLoopCallback( * For unwinding everything once the iterating is done. */ -done: + done: TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); - if (searchPtr->resultList != NULL) { - TclDecrRefCount(searchPtr->resultList); - } TclDecrRefCount(scriptObj); Tcl_DictObjDone(searchPtr); TclStackFree(interp, searchPtr); @@ -2568,6 +2546,216 @@ done: /* *---------------------------------------------------------------------- * + * DictMapNRCmd -- + * + * These functions implement the "dict map" Tcl command. See the user + * documentation for details on what it does, and TIP#405 for the formal + * specification. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictMapNRCmd( + ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Interp *iPtr = (Interp *) interp; + Tcl_Obj **varv, *keyObj, *valueObj; + DictMapStorage *storagePtr; + int varc, done; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "{keyVar valueVar} dictionary script"); + return TCL_ERROR; + } + + /* + * Parse arguments. + */ + + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { + return TCL_ERROR; + } + if (varc != 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must have exactly two variable names", -1)); + return TCL_ERROR; + } + storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage)); + if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, + &valueObj, &done) != TCL_OK) { + TclStackFree(interp, storagePtr); + return TCL_ERROR; + } + if (done) { + /* + * Note that this exit leaves an empty value in the result (due to + * command calling conventions) but that is OK since an empty value is + * an empty dictionary. + */ + + TclStackFree(interp, storagePtr); + return TCL_OK; + } + TclNewObj(storagePtr->accumulatorObj); + TclListObjGetElements(NULL, objv[1], &varc, &varv); + storagePtr->keyVarObj = varv[0]; + storagePtr->valueVarObj = varv[1]; + storagePtr->scriptObj = objv[3]; + + /* + * Make sure that these objects (which we need throughout the body of the + * loop) don't vanish. Note that the dictionary internal rep is locked + * internally so that updates, shimmering, etc are not a problem. + */ + + Tcl_IncrRefCount(storagePtr->keyVarObj); + Tcl_IncrRefCount(storagePtr->valueVarObj); + Tcl_IncrRefCount(storagePtr->scriptObj); + + /* + * Stop the value from getting hit in any way by any traces on the key + * variable. + */ + + Tcl_IncrRefCount(valueObj); + if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(valueObj); + goto error; + } + if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(valueObj); + goto error; + } + TclDecrRefCount(valueObj); + + /* + * Run the script. + */ + + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, + iPtr->cmdFramePtr, 3); + + /* + * For unwinding everything on error. + */ + + error: + TclDecrRefCount(storagePtr->keyVarObj); + TclDecrRefCount(storagePtr->valueVarObj); + TclDecrRefCount(storagePtr->scriptObj); + TclDecrRefCount(storagePtr->accumulatorObj); + Tcl_DictObjDone(&storagePtr->search); + TclStackFree(interp, storagePtr); + return TCL_ERROR; +} + +static int +DictMapLoopCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + DictMapStorage *storagePtr = data[0]; + Tcl_Obj *keyObj, *valueObj; + int done; + + /* + * Process the result from the previous execution of the script body. + */ + + if (result == TCL_CONTINUE) { + result = TCL_OK; + } else if (result != TCL_OK) { + if (result == TCL_BREAK) { + Tcl_ResetResult(interp); + result = TCL_OK; + } else if (result == TCL_ERROR) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"dict map\" body line %d)", + Tcl_GetErrorLine(interp))); + } + goto done; + } else { + keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL, + TCL_LEAVE_ERR_MSG); + if (keyObj == NULL) { + result = TCL_ERROR; + goto done; + } + Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj, + Tcl_GetObjResult(interp)); + } + + /* + * Get the next mapping from the dictionary. + */ + + Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done); + if (done) { + Tcl_ResetResult(interp); + goto done; + } + + /* + * Stop the value from getting hit in any way by any traces on the key + * variable. + */ + + Tcl_IncrRefCount(valueObj); + if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(valueObj); + result = TCL_ERROR; + goto done; + } + if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(valueObj); + result = TCL_ERROR; + goto done; + } + TclDecrRefCount(valueObj); + + /* + * Run the script. + */ + + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, + iPtr->cmdFramePtr, 3); + + /* + * For unwinding everything once the iterating is done. + */ + + done: + TclDecrRefCount(storagePtr->keyVarObj); + TclDecrRefCount(storagePtr->valueVarObj); + TclDecrRefCount(storagePtr->scriptObj); + TclDecrRefCount(storagePtr->accumulatorObj); + Tcl_DictObjDone(&storagePtr->search); + TclStackFree(interp, storagePtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * * DictSetCmd -- * * This function implements the "dict set" Tcl command. See the user @@ -3490,7 +3678,7 @@ TclInitDictCmd( { return TclMakeEnsemble(interp, "dict", implementationMap); } - + /* * Local Variables: * mode: c |