From fd7e0a944b77d1cbba91e323cd0679bf0d00652b Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 25 Nov 2015 06:29:43 -0800 Subject: New macro define-accessor. * lisplib.c (place_set_entries): New entry to trigger autoloading for define-accessor. * share/txr/stdlib/place.tl (sys:register-simple-accessor): New function. (define-accessor): New macro. * txr.1: Documented define-accessor. --- share/txr/stdlib/place.tl | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'share') diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index c60348e6..81a506a5 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -652,6 +652,25 @@ (symacrolet (,*(zip syms temps)) ,*body))))) +(defun sys:register-simple-accessor (get-fun set-fun) + (sethash *place-update-expander* get-fun + (lambda (getter setter place body) + (let* ((args (cdr place)) + (temps (mapcar (ret (gensym)) args))) + ^(let (,(zip temps args)) + (macrolet ((,getter () ^(,',get-fun ,*',temps)) + (,setter (val) + ^(,',set-fun ,*',temps ,val))) + ,body))))) + (sethash *place-clobber-expander* get-fun + (lambda (ssetter place body) + ^(macrolet ((,ssetter (val) + ^(,',set-fun ,*(cdr ',place) ,val))) + ,body)))) + +(defmacro define-accessor (get-fun set-fun) + ^(sys:register-simple-accessor ',get-fun ',set-fun)) + (define-place-macro first (obj) ^(car ,obj)) (define-place-macro rest (obj) ^(cdr ,obj)) (define-place-macro second (obj) ^(ref ,obj 1)) -- cgit v1.2.3