Index: doc/lrange.n ================================================================== --- doc/lrange.n +++ doc/lrange.n @@ -70,11 +70,11 @@ % \fBlrange\fR $var 1 1 {elements to} .CE .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lreplace(n), lsort(n), +lset(n), lremove(n), lreplace(n), lsort(n), string(n) .SH KEYWORDS element, list, range, sublist '\" Local Variables: '\" mode: nroff ADDED doc/lremove.n Index: doc/lremove.n ================================================================== --- /dev/null +++ doc/lremove.n @@ -0,0 +1,55 @@ +'\" +'\" Copyright (c) 2019 Donal K. Fellows. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH lremove n 8.7 Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +lremove \- Remove elements from a list by index +.SH SYNOPSIS +\fBlremove \fIlist\fR ?\fIindex ...\fR? +.BE +.SH DESCRIPTION +.PP +\fBlremove\fR returns a new list formed by simultaneously removing zero or +more elements of \fIlist\fR at each of the indices given by an arbirary number +of \fIindex\fR arguments. The indices may be in any order and may be repeated; +the element at index will only be removed once. The index values are +interpreted the same as index values for the command \fBstring index\fR, +supporting simple index arithmetic and indices relative to the end of the +list. 0 refers to the first element of the list, and \fBend\fR refers to the +last element of the list. +.SH EXAMPLES +.PP +Removing the third element of a list: +.PP +.CS +% \fBlremove\fR {a b c d e} 2 +a b d e +.CE +.PP +Removing two elements from a list: +.PP +.CS +% \fBlremove\fR {a b c d e} end-1 1 +a c e +.CE +.PP +Removing the same element indicated in two different ways: +.PP +.CS +% \fBlremove\fR {a b c d e} 2 end-2 +a b d e +.CE +.SH "SEE ALSO" +list(n), lrange(n), lsearch(n), lsearch(n) +.SH KEYWORDS +element, list, remove +.\" Local variables: +.\" mode: nroff +.\" fill-column: 78 +.\" End: Index: doc/lreplace.n ================================================================== --- doc/lreplace.n +++ doc/lreplace.n @@ -94,11 +94,11 @@ a b c d e f g h i .CE .VE TIP505 .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lrange(n), lsort(n), +lset(n), lrange(n), lremove(n), lsort(n), string(n) .SH KEYWORDS element, list, replace .\" Local variables: .\" mode: nroff Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -260,10 +260,11 @@ {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"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}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -2698,10 +2698,146 @@ } Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * 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, first, num; + Tcl_Obj *listObj; + + /* + * Parse the arguments. + */ + + 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. + */ + + if (Tcl_IsShared(listObj)) { + listObj = TclListObjCopy(NULL, listObj); + } + num = 0; + first = listLen; + 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; + } + + /* + * Coalesce adjacent removes to reduce the number of copies. + */ + + if (num == 0) { + num = 1; + first = idx; + } else if (idx + 1 == first) { + num++; + first = idx; + } else { + /* + * 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, first, num, 0, NULL); + listLen -= num; + num = 1; + first = idx; + } + } + if (num != 0) { + (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); + } + ckfree(idxv); + Tcl_SetObjResult(interp, listObj); + return TCL_OK; +} /* *---------------------------------------------------------------------- * * Tcl_LrepeatObjCmd -- Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -3468,10 +3468,13 @@ MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); 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[]); MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, Index: tests/cmdIL.test ================================================================== --- tests/cmdIL.test +++ tests/cmdIL.test @@ -17,11 +17,11 @@ catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] - + test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} @@ -771,23 +771,68 @@ lindex $x 0 } -cleanup { unset -nocomplain x y rename K {} } -result 1 + +test cmdIL-8.1 {lremove command: error path} -returnCodes error -body { + lremove +} -result {wrong # args: should be "lremove list ?index ...?"} +test cmdIL-8.2 {lremove command: error path} -returnCodes error -body { + lremove {{}{}} +} -result {list element in braces followed by "{}" instead of space} +test cmdIL-8.3 {lremove command: error path} -returnCodes error -body { + lremove {a b c} gorp +} -result {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?} +test cmdIL-8.4 {lremove command: no indices} -body { + lremove {a b c} +} -result {a b c} +test cmdIL-8.5 {lremove command: before start} -body { + lremove {a b c} -1 +} -result {a b c} +test cmdIL-8.6 {lremove command: after end} -body { + lremove {a b c} 3 +} -result {a b c} +test cmdIL-8.7 {lremove command} -body { + lremove {a b c} 0 +} -result {b c} +test cmdIL-8.8 {lremove command} -body { + lremove {a b c} 1 +} -result {a c} +test cmdIL-8.9 {lremove command} -body { + lremove {a b c} end +} -result {a b} +test cmdIL-8.10 {lremove command} -body { + lremove {a b c} end-1 +} -result {a c} +test cmdIL-8.11 {lremove command} -body { + lremove {a b c d e} 1 3 +} -result {a c e} +test cmdIL-8.12 {lremove command} -body { + lremove {a b c d e} 3 1 +} -result {a c e} +test cmdIL-8.13 {lremove command: same index twice} -body { + lremove {a b c d e} 2 2 +} -result {a b d e} +test cmdIL-8.14 {lremove command: same index twice} -body { + lremove {a b c d e} 3 end-1 +} -result {a b c e} +test cmdIL-8.15 {lremove command: many indices} -body { + lremove {a b c d e} 1 3 1 4 0 +} -result {c} # This belongs in info test, but adding tests there breaks tests # that compute source file line numbers. test info-20.6 {Bug 3587651} -setup { namespace eval my {namespace eval tcl {namespace eval mathfunc { proc demo x {return 42} }}}} -body { namespace eval my {expr {"demo" in [info functions]}}} -cleanup { namespace delete my } -result 1 - - + # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: