diff options
| -rw-r--r-- | eval.c | 12 | ||||
| -rw-r--r-- | lib.c | 27 | ||||
| -rw-r--r-- | lib.h | 4 | ||||
| -rw-r--r-- | share/txr/stdlib/place.tl | 20 | ||||
| -rw-r--r-- | txr.1 | 151 |
5 files changed, 158 insertions, 56 deletions
@@ -2669,11 +2669,11 @@ static val optimize_qquote_form(val form) sym = list_s; args = mappend(cdr_f, args); } else { - val blargs = butlast(args); + val blargs = butlast(args, nil); if (all_satisfy(blargs, list_form_p_f, nil)) return rlcp_tree(cons(list_star_s, nappend2(mappend(cdr_f, blargs), - last(args))), form); + last(args, one))), form); } } @@ -3229,7 +3229,7 @@ static val me_whilet(val form, val env) val body = form; val sym = pop(&body); val lets = pop(&body); - val lastlet = last(lets); + val lastlet = last(lets, nil); val not_done = gensym(lit("not-done")); if (nilp(lastlet)) @@ -3253,7 +3253,7 @@ static val me_iflet_whenlet(val form, val env) return apply_frob_args(list(if3(sym == iflet_s, if_s, when_s), lets, args, nao)); } else { - val lastlet = last(lets); + val lastlet = last(lets, nil); if (nilp(lastlet)) eval_error(form, lit("~s: empty binding list"), sym, nao); @@ -4975,8 +4975,8 @@ void eval_init(void) reg_fun(intern(lit("nreverse"), user_package), func_n1(nreverse)); reg_fun(intern(lit("reverse"), user_package), func_n1(reverse)); reg_fun(intern(lit("ldiff"), user_package), func_n2(ldiff)); - reg_fun(intern(lit("last"), user_package), func_n1(last)); - reg_fun(intern(lit("butlast"), user_package), func_n1(butlast)); + reg_fun(intern(lit("last"), user_package), func_n2o(last, 1)); + reg_fun(intern(lit("butlast"), user_package), func_n2o(butlast, 1)); reg_fun(intern(lit("nthlast"), user_package), func_n2(nthlast)); reg_fun(intern(lit("nthcdr"), user_package), func_n2(nthcdr)); reg_fun(intern(lit("butlastn"), user_package), func_n2(butlastn)); @@ -575,13 +575,21 @@ loc lastcons(val list) return ret; } -val last(val seq) +val last(val seq, val n) { - if (listp(seq)) { - loc p = lastcons(seq); - return nullocp(p) ? seq : deref(p); + if (null_or_missing_p(n)) { + if (listp(seq)) { + loc p = lastcons(seq); + return nullocp(p) ? seq : deref(p); + } + return sub(seq, negone, t); + } else { + if (listp(seq)) + return nthlast(n, seq); + return if3(plusp(n), + sub(seq, neg(n), t), + sub(seq, t, t)); } - return sub(seq, negone, t); } val nthcdr(val pos, val list) @@ -8414,9 +8422,14 @@ val dwim_del(val seq, val ind_range) } } -val butlast(val seq) +val butlast(val seq, val idx) { - return sub(seq, zero, negone); + if (listp(seq)) { + return butlastn(default_arg(idx, one), seq); + } else { + val nidx = if3(null_or_missing_p(idx), negone, neg(idx)); + return sub(seq, zero, if3(plusp(nidx), zero, nidx)); + } } val update(val seq, val fun) @@ -507,7 +507,7 @@ loc listref_l(val list, val ind); loc tail(val cons); loc term(loc head); loc lastcons(val list); -val last(val list); +val last(val list, val n); val nthlast(val pos, val list); val nthcdr(val pos, val list); val butlastn(val n, val list); @@ -964,7 +964,7 @@ val ref(val seq, val ind); val refset(val seq, val ind, val newval); val dwim_set(val seq, val ind_range, val newval); val dwim_del(val seq, val ind_range); -val butlast(val seq); +val butlast(val seq, val idx); val replace(val seq, val items, val from, val to); val update(val seq, val fun); val search(val seq, val key, val from, val to); diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 9bad42fa..aa534e4a 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -887,3 +887,23 @@ (define-place-macro eighth (obj) ^(ref ,obj 7)) (define-place-macro ninth (obj) ^(ref ,obj 8)) (define-place-macro tenth (obj) ^(ref ,obj 9)) + +(define-place-macro last (obj : (n nil have-n)) + (cond + ((and have-n (constantp n) (not (plusp n))) + ^(sub ,obj t t)) + ((and have-n (constantp n)) + ^(sub ,obj ,(- n) t)) + (have-n + ^(sub ,obj (- (max ,n 0)) t)) + (t ^(sub ,obj -1 t)))) + +(define-place-macro butlast (obj : (n nil have-n)) + (cond + ((and have-n (constantp n) (not (plusp n))) + obj) + ((and have-n (constantp n)) + ^(sub ,obj 0 ,(- n))) + (have-n + ^(sub ,obj 0 (- (max ,n 0)))) + (t ^(sub ,obj 0 -1)))) @@ -16584,36 +16584,6 @@ See the relevant examples below. (ldiff "abc" #(#\eb #\ec)) -> "abc" .cble -.coNP Function @ last -.synb -.mets (last << seq ) -.syne -.desc -If -.meta seq -is a nonempty proper or improper list, the -.code last -function -returns the last cons cell in the list: that cons cell whose -.code cdr -field is a terminating atom. - -If -.meta seq -is -.codn nil , -then -.code nil -is returned. - -If -.meta seq -is a non-list sequence, then a one-element suffix of -.code seq -is returned, or an empty suffix if -.code seq -is an empty sequence. - .coNP Accessor @ nthlast .synb .mets (nthlast < index << list ) @@ -23061,29 +23031,128 @@ is returned, which may be .meta sequence itself or a copy. -.coNP Function @ butlast +.coNP Accessor @ last +.synb +.mets (last << seq <> [ num ]) +.mets (set (last << seq <> [ num ]) << new-value) +.syne +.desc +The +.meta last +function returns a subsequence of +.meta seq +consisting of the last +.meta num +of its elements, where +.meta num +defaults to 1. + +If +.meta num +is zero or negative, then an empty sequence is returned. +If +.meta num +is positive, and greater than or equal to the length of seq, +then seq +.meta seq +is returned. + +If a +.code last +form is used as a place, then +.code seq +must be a place. The following equivalence gives the semantics +of assignment to a +.codn last : + +.cble + (set (last x n) v) <--> (set (sub x (- (max n 0)) t) v) +.cblk + +A +.code last +place is deletable. The semantics of deletion may be understood +in terms of the following equivalence: + +.cble + (del (last x n)) <--> (del (sub x (- (max n 0)) t)) +.cble + +.coNP Accessor @ butlast .synb -.mets (butlast << sequence ) +.mets (butlast << sequence <> [ num ]) +.mets (set (butlast << sequence <> [ num ]) << new-value ) .syne .desc The .code butlast function returns the prefix of .meta sequence -consisting of a copy of it, with the last item omitted. +consisting of a copy of it, with the last +.meta num +items removed. + +The parameter +.meta num +defaults to 1 +if an argument is omitted. + If .meta sequence is empty, an empty sequence is returned. -Dialect note: the Common Lisp function -.code nbutlast -is not provided. The \*(TL +If +.meta num +is zero or negative, then +.meta sequence +is returned. + +If +.meta num +is positive, and meets or exceeds the length of +.metn sequence , +then an empty sequence is returned. + +If a +.code butlast +form is used as a place, then +.meta sequence +must itself be a place. The following equivalence gives the semantics +of assignment to a +.codn last : + +.cble + (set (butlast x n) v) <--> (set (sub x 0 (- (max n 0))) v) +.cblk + +A +.code butlast +place is deletable. The semantics of deletion may be understood +in terms of the following equivalence: + +.cble + (del (last x n)) <--> (del (sub x 0 (- (max n 0)))) +.cble + +Note: the \*(TL .code take -function provides the same functionality for lists (only with the -arguments reversed relative to -.codn nbutlast ), -and additionally provides lazy semantics, and works with vectors -and strings. +function also computes the prefix of a list; however, it counts items +from the beginning, and provides lazy semantics which allow it +to work with infinite lists. + +See also: the +.code butlastn +accessor, which operates on lists. That function has useful semantics for +improper lists and treats an atom as the terminator of a zero-length improper +list. + +Dialect note: a destructive function similar to Common Lisp's +.code nbutlast +isn't provided. Of course, assignment to an +.code butlast +form is destructive; Common Lisp doesn't support +.code butlast +as a place. .coNP Function @ search .synb |