diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-10-25 06:39:58 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-10-25 06:39:58 -0700 |
| commit | dcd3ef3f78ee3f17d7c706ccaa1ff74c5dc7f104 (patch) | |
| tree | 21ca552d490ee18594391b5d3435abb0c2feedb7 /share | |
| parent | 95abf5aa1cb792bdcb472399d1ef9dfc9b9088e0 (diff) | |
| download | txr-dcd3ef3f78ee3f17d7c706ccaa1ff74c5dc7f104.tar.gz txr-dcd3ef3f78ee3f17d7c706ccaa1ff74c5dc7f104.tar.bz2 txr-dcd3ef3f78ee3f17d7c706ccaa1ff74c5dc7f104.zip | |
New accessors nthlast and butlastn.
* eval.c (eval_init): register nthlast and butlastn
intrinsicis.
* lib.c (nthlast, butlastn): New function.
* lib.h (nthlast, butlastn): Declared.
* share/txr/stdlib/place.tl (defplace nthlast,
defplace butlastn): New places.
* txr.1: Documented nthlast and butlastn.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/place.tl | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 198dbb19..320cf90e 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -478,6 +478,45 @@ ^(sys:rplacd ,',parent-cell-sym ,val))) ,body))))))) +(defplace (nthlast index list) body + (getter setter + (with-gensyms (index-sym list-sym sentinel-head-sym parent-cell-sym) + (if (place-form-p list sys:*pl-env*) + (with-update-expander (lgetter lsetter) list nil + ^(alet ((,index-sym ,index) + (,list-sym (,lgetter))) + (let* ((,sentinel-head-sym (cons nil ,list-sym)) + (,parent-cell-sym (nthlast (succ ,index-sym) + ,sentinel-head-sym))) + (macrolet ((,getter () ^(cdr ,',parent-cell-sym)) + (,setter (val) + ^(prog1 (sys:rplacd ,',parent-cell-sym ,val) + (,',lsetter (cdr ,',sentinel-head-sym))))) + ,body)))) + ^(alet ((,index-sym index) + (,list-sym ,list)) + (let ((,parent-cell-sym (nthlast (succ ,index-sym) ,list-sym))) + (macrolet ((,getter () ^(cdr ,',parent-cell-sym)) + (,setter (val) + ^(sys:rplacd ,',parent-cell-sym ,val))) + ,body))))))) + +(defplace (butlastn num list) body + (getter setter + (with-gensyms (num-sym list-sym head-sym tail-sym val-sym) + (with-update-expander (lgetter lsetter) list nil + ^(alet ((,num-sym ,num) + (,list-sym (,lgetter))) + (let* ((,tail-sym (nthlast ,num-sym ,list-sym)) + (,head-sym (ldiff ,list-sym ,tail-sym))) + (macrolet ((,getter () ,head-sym) + (,setter (val) + ^(alet ((,',val-sym ,val)) + (progn (,',lsetter (append ,',val-sym + ,',tail-sym)) + ,',val-sym)))) + ,body))))))) + (defplace (vecref vector index :whole args) body (getter setter (with-gensyms (vec-sym ind-sym) |