From 046b84edfab19fe52d8ff04f526fb2b56c816857 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 7 Sep 2016 19:20:59 -0700 Subject: New rslot macro to suport upcoming awk macro. This provides a way to create lexical macros denoting slots, such that method are invoked when they are updated. * lisplib.c (struct_set_entries): Add rslot to list of auto-load symbols for struct.tl module. * share/txr/stdlib/struct.tl (sys:rslotset): New function. (rslot, rslot): New macro and place macro. (sys:rslot): New place kind. --- lisplib.c | 2 +- share/txr/stdlib/struct.tl | 27 +++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/lisplib.c b/lisplib.c index 134264ad..b9b58f45 100644 --- a/lisplib.c +++ b/lisplib.c @@ -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))) -- cgit v1.2.3