diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 13 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | share/txr/stdlib/place.tl | 20 | ||||
| -rw-r--r-- | txr.1 | 60 |
6 files changed, 109 insertions, 0 deletions
@@ -1,5 +1,19 @@ 2015-07-22 Kaz Kylheku <kaz@kylheku.com> + Adding nthcdr as accessor. + + * eval.c (eval_init): Register nthcdr function. + + * lib.c (nthcdr): New function. + + * lib.h (nthcdr): Declared. + + * share/txr/stdlib/place.tl (nthcdr): New defplace. + + * txr.1: Documented. + +2015-07-22 Kaz Kylheku <kaz@kylheku.com> + Improve bad argument diagnosis for place macros. * eval.c (op_mac_param_bind): New static function. @@ -4164,6 +4164,7 @@ void eval_init(void) 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("nthcdr"), user_package), func_n2(nthcdr)); reg_fun(intern(lit("flatten"), user_package), func_n1(flatten)); reg_fun(intern(lit("flatten*"), user_package), func_n1(lazy_flatten)); reg_fun(intern(lit("tuples"), user_package), func_n3o(tuples, 2)); @@ -498,6 +498,19 @@ val last(val list) return nullocp(p) ? list : deref(p); } +val nthcdr(val pos, val list) +{ + cnum n = c_num(pos); + + if (n < 0) + uw_throwf(error_s, lit("nthcdr: negative index ~s given"), pos, nao); + + while (n-- > 0) + list = cdr(list); + + return list; +} + loc ltail(loc cons) { while (cdr(deref(cons))) @@ -457,6 +457,7 @@ loc tail(val cons); loc term(loc head); loc lastcons(val list); val last(val list); +val nthcdr(val pos, val list); loc ltail(loc cons); val pop(val *plist); val upop(val *plist, val *pundo); diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index e19caa2f..f086ce31 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -355,6 +355,26 @@ (prog1 (cdr ,tmp) (,csetter (car ,tmp)))))))) ,body))) +(defplace (nthcdr index list) body + (getter setter + (with-gensyms (index-sym sentinel-head-sym parent-cell-sym) + (if (place-form-p list) + (with-update-expander (lgetter lsetter) list nil + ^(rlet ((,index-sym ,index)) + (let* ((,sentinel-head-sym (cons nil (,lgetter))) + (,parent-cell-sym (nthcdr ,index-sym ,sentinel-head-sym))) + (macrolet ((,getter () ^(cdr ,',parent-cell-sym)) + (,setter (val) + ^(progn (sys:rplacd ,',parent-cell-sym ,val) + (,',lsetter (cdr ,',sentinel-head-sym))))) + ,body)))) + ^(rlet ((,index-sym ,index)) + (let* ((,parent-cell-sym (nthcdr (pred ,index-sym) ,list))) + (macrolet ((,getter () ^(cdr ,',parent-cell-sym)) + (,setter (val) + ^(sys:rplacd ,',parent-cell-sym ,val))) + ,body))))))) + (defplace (vecref vector index :whole args) body (getter setter (with-gensyms (vec-sym ind-sym) @@ -14191,6 +14191,66 @@ then .code nil is returned. +.coNP Accessor @ nthcdr +.synb +.mets (nthcdr < index << list ) +.mets (set (nthcdr < index << list ) << new-value ) +.syne +.desc +The +.code nthcdr +function retrieves the n-th cons cell of a list, indexed from zero. +The +.meta index +parameter must be a non-negative integer. If +.meta index +specifies a nonexistent cons beyond the end of the list, +then +.code nthcdr +yields nil. +The following equivalences hold: + +.cblk + (nthcdr 0 list) <--> list + (nthcdr 1 list) <--> (cdr list) + (nthcdr 2 list) <--> (cddr list) +.cble + +An +.code nthcdr +place designates the storage location which holds the n-th cell, +as indicated by the value of +.metn index . +Indices beyond the last cell of +.meta list +do not designate a valid place. +If +.meta list +is itself a place, then the zeroth index is permitted and the +resulting place denotes +.metn list . +Storing a value to +.cblk +.meti (nthcdr < 0 << list) +.cble +overwrites +.metn list . +Otherwise if +.meta list +isn't a syntactic place, then the zeroth index does not designate a valid +place; +.meta index +must have a positive value. A +.code nthcdr +place does not support deletion. + +.TP* "Dialect Note:" +In Common Lisp, +.code nthcdr +is only a function, not an accessor; +.code nthcdr +forms do not denote places. + .coNP Accessors @, caar @, cadr @, cdar @, cddr ... @ cdddddr .synb .mets (caar << object ) |