diff options
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/struct.tl | 27 |
2 files changed, 28 insertions, 1 deletions
@@ -178,7 +178,7 @@ static val struct_set_entries(val dlt, val fun) { val name[] = { lit("defstruct"), lit("qref"), lit("new"), lit("meth"), - lit("umeth"), lit("usl"), lit("defmeth"), nil + lit("umeth"), lit("usl"), lit("defmeth"), lit("rslot"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 2f9dcfb4..9b37ae0b 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -255,3 +255,30 @@ (ret ^(,@1 (slot ,obj-sym ',@1)))] slot-specs)) ,*body)))) + +(macro-time + (defun sys:rslotset (struct sym meth-sym val) + (slotset struct sym val) + (call (umethod meth-sym) struct))) + +(defmacro rslot (struct sym meth-sym) + ^(slot ,struct ,sym)) + +(define-place-macro rslot (struct sym meth-sym) + ^(sys:rslot ,struct ,sym ,meth-sym)) + +(defplace (sys:rslot struct sym meth-sym) body + (getter setter + (with-gensyms (struct-sym slot-sym meth-sym) + ^(rlet ((,struct-sym ,struct) + (,slot-sym ,sym) + (,meth-sym ,meth-sym)) + (macrolet ((,getter () ^(slot ,',struct-sym ,',slot-sym)) + (,setter (val) ^(sys:rslotset ,',struct-sym + ,',slot-sym ,val))) + ,body)))) + (ssetter + ^(macrolet ((,ssetter (val) ^(progn + (sys:rslotset ,',struct ,',sym + ,',meth-sym ,val)))) + ,body))) |