diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-10-26 06:17:14 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-10-26 06:17:14 -0700 |
| commit | bc0d27c80e2f7b534ba1efd3f60210b5855f65c1 (patch) | |
| tree | a41320843ddd9827c7d6657898305488edd4f18e /share | |
| parent | dcd3ef3f78ee3f17d7c706ccaa1ff74c5dc7f104 (diff) | |
| download | txr-bc0d27c80e2f7b534ba1efd3f60210b5855f65c1.tar.gz txr-bc0d27c80e2f7b534ba1efd3f60210b5855f65c1.tar.bz2 txr-bc0d27c80e2f7b534ba1efd3f60210b5855f65c1.zip | |
sub function becomes accessor.
* share/txr/stdlib/place.tl (defplace sub): New place.
* txr.1: Document sub as accessor.
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 320cf90e..9bad42fa 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -580,6 +580,45 @@ ,',ind-sym (succ ,',ind-sym))))) ,body))))) +(defplace (sub seq :whole args : (from 0) (to t)) body + (getter setter + (with-gensyms (seq-sym from-sym to-sym v-sym) + (with-update-expander (seq-getter seq-setter) seq nil + ^(alet ((,seq-sym (,seq-getter)) + (,from-sym ,from) + (,to-sym ,to)) + (macrolet ((,getter () ^(sub ,',seq-sym ,',from-sym ,',to-sym)) + (,setter (val) + ^(alet ((,',v-sym ,val)) + (,seq-setter (replace ,',seq-sym ,',v-sym + ,',from-sym ,',to-sym)) + ,',v-sym))) + ,body))))) + (ssetter + (with-gensyms (seq-sym from-sym to-sym v-sym) + (with-update-expander (seq-getter seq-setter) seq nil + ^(macrolet ((,ssetter (val) + ^(alet ((,',seq-sym (,',seq-getter)) + (,',from-sym ,',from) + (,',to-sym ,',to) + (,',v-sym ,val)) + (,',seq-setter (replace ,',seq-sym ,',v-sym + ,',from-sym ,',to-sym)) + ,',v-sym))) + ,body)))) + (deleter + (with-gensyms (seq-sym from-sym to-sym) + (with-update-expander (seq-getter seq-setter) seq nil + ^(alet ((,seq-sym (,seq-getter)) + (,from-sym ,from) + (,to-sym ,to)) + (macrolet ((,deleter () + ^(prog1 + (sub ,',seq-sym ,',from-sym ,',to-sym) + (,',seq-setter (replace ,',seq-sym nil + ,',from-sym ,',to-sym))))) + ,body)))))) + (defplace (gethash hash key : (default nil have-default-p)) body (getter setter (with-gensyms (entry-sym) |