diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 22 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/010/cons.tl | 14 | ||||
| -rw-r--r-- | txr.1 | 71 |
6 files changed, 110 insertions, 0 deletions
@@ -6916,6 +6916,7 @@ void eval_init(void) reg_fun(intern(lit("split*"), user_package), func_n2(split_star)); reg_fun(intern(lit("partition*"), user_package), func_n2(partition_star)); reg_fun(intern(lit("tailp"), user_package), func_n2(tailp)); + reg_fun(intern(lit("delcons"), user_package), func_n2(delcons)); reg_fun(memq_s, func_n2(memq)); reg_fun(memql_s, func_n2(memql)); reg_fun(memqual_s, func_n2(memqual)); @@ -2796,6 +2796,28 @@ val tailp(val obj, val list) return t; } +val delcons(val cons, val list) +{ + val iter = list; + + if (!consp(cons)) + return list; + + if (cons == iter) + return cdr(iter); + + while (consp(iter)) { + val d = us_cdr(iter); + if (cons == d) { + us_rplacd(iter, us_cdr(cons)); + break; + } + iter = d; + } + + return list; +} + val memq(val obj, val list) { val list_orig = list; @@ -677,6 +677,7 @@ val split(val seq, val indices); val partition_star(val seq, val indices); val split_star(val seq, val indices); val tailp(val obj, val list); +val delcons(val cons, val list); val memq(val obj, val list); val rmemq(val obj, val list); val memql(val obj, val list); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 0bb8b82b..a14a83d6 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -482,6 +482,7 @@ ("del" "D-0022") ("del*" "N-0166445C") ("delay" "N-00DCE524") + ("delcons" "N-03A1ABA8") ("delete-package" "N-02E687F3") ("derived" "N-0151798B") ("dev-t" "N-01D716FE") diff --git a/tests/010/cons.tl b/tests/010/cons.tl new file mode 100644 index 00000000..de293652 --- /dev/null +++ b/tests/010/cons.tl @@ -0,0 +1,14 @@ +(load "../common") + +(let ((x (list* 1 2 3 4))) + (mtest + (set x (delcons x x)) (2 3 . 4) + (set x (delcons x x)) (3 . 4) + (set x (delcons x x)) 4 + (set x (delcons x x)) 4)) + +(let ((x (list* 1 2 3 4 5))) + (mtest + (delcons (cdr x) x) (1 3 4 . 5) + (delcons (cddr x) x) (1 3 . 5) + (delcons (cdr x) x) (1 . 5))) @@ -22277,6 +22277,77 @@ can be expressed as: (conses list1) ... (conses listn)) .brev +.coNP Function @ delcons +.synb +.mets (delcons < cons << list ) +.syne +.desc +The +.code delcons +function destructively removes a cons cell from a list. The +.meta list +is searched to see whether one of its cons cells is the same object as +.metn cons . +If so, that cell is removed from the list. + +The +.meta list +argument may be a proper or improper list, possibly empty. It may also be an +atom other than +.codn nil , +which is regarded as being, effectively, am empty improper list terminated by +that atom. + +The operation of +.code delcons +is divided into the following three cases. If +.meta cons +is the first cons cell of +.metn list , +then the +.code cdr +of +.meta list +is returned. If +.meta cons +is the second or subsequent cons of +.metn list , +then +.meta list +is destructively altered to remove +.meta cons +and then returned. This means that the +.code cdr +field of the predecessor of +.meta cons +is altered from referencing +.meta cons +to referencing +.mono +.meti (cdr << cons ) +.onom +instead. +The returned value is the same cons cell as +.metn list . +The third case occurs when +.meta cons +is not found in +.metn list . +In this situation, +.meta list +is returned unchanged. + +.TP* Examples: +.verb + (let ((x (list 1 2 3))) + (delcons x x)) + -> (2 3) + + (let ((x (list 1 2 . 3))) + (delcons (cdr x) x)) + -> (1 . 3) +.brev + .SS* Association Lists Association lists are ordinary lists formed according to a special convention. |