diff options
| -rw-r--r-- | generic/tclBasic.c | 1 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 114 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 |
3 files changed, 118 insertions, 0 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1806557..e377951 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -262,6 +262,7 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index a1a7f3e..0e36455 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2704,6 +2704,120 @@ Tcl_LrangeObjCmd( /* *---------------------------------------------------------------------- * + * Tcl_LremoveObjCmd -- + * + * This procedure is invoked to process the "lremove" Tcl command. See the + * user documentation for details on what it does. + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +typedef int list_index_t; + +static int +LremoveIndexCompare( + const void *el1Ptr, + const void *el2Ptr) +{ + list_index_t idx1 = *((const list_index_t *) el1Ptr); + list_index_t idx2 = *((const list_index_t *) el2Ptr); + + /* + * This will put the larger element first. + */ + + return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0; +} + +int +Tcl_LremoveObjCmd( + ClientData notUsed, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i, idxc; + list_index_t listLen, *idxv, prevIdx; + Tcl_Obj *listObj; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?"); + return TCL_ERROR; + } + + listObj = objv[1]; + if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) { + return TCL_ERROR; + } + + idxc = objc - 2; + if (idxc == 0) { + Tcl_SetObjResult(interp, listObj); + return TCL_OK; + } + idxv = ckalloc((objc - 2) * sizeof(list_index_t)); + for (i = 2; i < objc; i++) { + if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, + &idxv[i - 2]) != TCL_OK) { + ckfree(idxv); + return TCL_ERROR; + } + } + + /* + * Sort the indices, large to small so that when we remove an index we + * don't change the indices still to be processed. + */ + + if (idxc > 1) { + qsort(idxv, idxc, sizeof(list_index_t), LremoveIndexCompare); + } + + /* + * Make our working copy, then do the actual removes piecemeal. It would + * be more efficient to do range coalescing; contributions accepted! + */ + + if (Tcl_IsShared(listObj)) { + listObj = TclListObjCopy(NULL, listObj); + } + for (i = 0, prevIdx = -1 ; i < idxc ; i++) { + list_index_t idx = idxv[i]; + + /* + * Repeated index and sanity check. + */ + + if (idx == prevIdx) { + continue; + } + prevIdx = idx; + if (idx < 0 || idx >= listLen) { + continue; + } + + /* + * Note that this operation can't fail now; we know we have a list and + * we're only ever contracting that list. + */ + + (void) Tcl_ListObjReplace(interp, listObj, idx, 1, 0, NULL); + listLen--; + } + ckfree(idxv); + Tcl_SetObjResult(interp, listObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_LrepeatObjCmd -- * * This procedure is invoked to process the "lrepeat" Tcl command. See diff --git a/generic/tclInt.h b/generic/tclInt.h index 9fc778b..6a3eafe 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3471,6 +3471,9 @@ MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LremoveObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |