summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c110
1 files changed, 96 insertions, 14 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f09ee70..333946a 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -32,6 +32,7 @@ struct ForeachState {
int *argcList; /* Array of value list sizes. */
Tcl_Obj ***argvList; /* Array of value lists. */
Tcl_Obj **aCopyList; /* Copies of value list arguments. */
+ Tcl_Obj *resultList; /* List of result values from the loop body. */
};
/*
@@ -44,7 +45,7 @@ static int EncodingDirsObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static inline int ForeachAssignments(Tcl_Interp *interp,
- struct ForeachState *statePtr);
+ struct ForeachState *statePtr, int collect);
static inline void ForeachCleanup(Tcl_Interp *interp,
struct ForeachState *statePtr);
static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -52,6 +53,8 @@ static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static const char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
+static int TclNREachloopCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[], int collect);
static Tcl_NRPostProc CatchObjCmdCallback;
static Tcl_NRPostProc ExprCallback;
static Tcl_NRPostProc ForSetupCallback;
@@ -2560,7 +2563,7 @@ ForPostNextCallback(
/*
*----------------------------------------------------------------------
*
- * Tcl_ForeachObjCmd, TclNRForeachCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, TclNREachloopCmd --
*
* This object-based procedure is invoked to process the "foreach" Tcl
* command. See the user documentation for details on what it does.
@@ -2592,6 +2595,58 @@ TclNRForeachCmd(
int objc,
Tcl_Obj *const objv[])
{
+ return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_KEEP_NONE);
+}
+
+int
+Tcl_MapeachObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRMapeachCmd, dummy, objc, objv);
+}
+
+int
+TclNRMapeachCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_COLLECT);
+}
+
+int
+Tcl_ForeachaObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRForeachaCmd, dummy, objc, objv);
+}
+
+int
+TclNRForeachaCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_ACCUM);
+}
+
+int
+TclNREachloopCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[],
+ int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */
+{
+
int numLists = (objc-2) / 2;
register struct ForeachState *statePtr;
int i, j, result;
@@ -2635,6 +2690,8 @@ TclNRForeachCmd(
statePtr->bodyPtr = objv[objc - 1];
statePtr->bodyIdx = objc - 1;
+ statePtr->resultList = Tcl_NewListObj(0, NULL);
+
/*
* Break up the value lists and variable lists into elements.
*/
@@ -2663,9 +2720,13 @@ TclNRForeachCmd(
TclListObjGetElements(NULL, statePtr->aCopyList[i],
&statePtr->argcList[i], &statePtr->argvList[i]);
- j = statePtr->argcList[i] / statePtr->varcList[i];
- if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
- j++;
+ j = (i == 0) && (collect == TCL_EACH_ACCUM); /* Accumulator present? */
+ /* If accumulator is only var in list, then we iterate j=1 times */
+ if (statePtr->varcList[i] > j) {
+ /* We need listLen/numVars round up = ((listLen+numVars-1)/numVars)
+ * When accum is present we need (listLen-1)/(numVars-1) round up */
+ j = (statePtr->argcList[i] - j + statePtr->varcList[i] - j - 1)
+ / (statePtr->varcList[i] - j);
}
if (j > statePtr->maxj) {
statePtr->maxj = j;
@@ -2678,12 +2739,12 @@ TclNRForeachCmd(
*/
if (statePtr->maxj > 0) {
- result = ForeachAssignments(interp, statePtr);
+ result = ForeachAssignments(interp, statePtr, collect);
if (result == TCL_ERROR) {
goto done;
}
- TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0,
((Interp *) interp)->cmdFramePtr, objc-1);
}
@@ -2710,6 +2771,7 @@ ForeachLoopStep(
int result)
{
register struct ForeachState *statePtr = data[0];
+ int collect = (int)data[1]; /* Selected collecting or accumulating mode. */
/*
* Process the result code from this run of the [foreach] body. Note that
@@ -2719,11 +2781,15 @@ ForeachLoopStep(
switch (result) {
case TCL_CONTINUE:
result = TCL_OK;
+ break;
case TCL_OK:
+ if (collect == TCL_EACH_COLLECT) {
+ Tcl_ListObjAppendElement(interp, statePtr->resultList, Tcl_GetObjResult(interp));
+ }
break;
case TCL_BREAK:
result = TCL_OK;
- goto done;
+ goto finish;
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
@@ -2737,12 +2803,12 @@ ForeachLoopStep(
*/
if (statePtr->maxj > ++statePtr->j) {
- result = ForeachAssignments(interp, statePtr);
+ result = ForeachAssignments(interp, statePtr, collect);
if (result == TCL_ERROR) {
goto done;
}
- TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
}
@@ -2750,8 +2816,18 @@ ForeachLoopStep(
/*
* We're done. Tidy up our work space and finish off.
*/
-
- Tcl_ResetResult(interp);
+finish:
+ if (collect == TCL_EACH_ACCUM) {
+ Tcl_Obj* valueObj = Tcl_ObjGetVar2(interp, statePtr->varvList[0][0],
+ NULL, TCL_LEAVE_ERR_MSG);
+ if (valueObj == NULL) {
+ goto done;
+ }
+ Tcl_SetObjResult(interp, valueObj);
+ } else {
+ Tcl_SetObjResult(interp, statePtr->resultList);
+ statePtr->resultList = NULL; /* Don't clean it up */
+ }
done:
ForeachCleanup(interp, statePtr);
return result;
@@ -2764,13 +2840,16 @@ ForeachLoopStep(
static inline int
ForeachAssignments(
Tcl_Interp *interp,
- struct ForeachState *statePtr)
+ struct ForeachState *statePtr,
+ int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */
{
int i, v, k;
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
- for (v=0 ; v<statePtr->varcList[i] ; v++) {
+ /* Don't modify the accumulator except on the first iteration */
+ v = ((i == 0) && (collect == TCL_EACH_ACCUM) && (statePtr->index[i] > 0));
+ for (; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
@@ -2813,6 +2892,9 @@ ForeachCleanup(
TclDecrRefCount(statePtr->aCopyList[i]);
}
}
+ if (statePtr->resultList) {
+ TclDecrRefCount(statePtr->resultList);
+ }
TclStackFree(interp, statePtr);
}
generated by cgit v0.12 at 2024-11-22 09:28:30 (GMT)