On Tue, Jan 24, 2012 at 11:51 AM, Martin Simmons martin@lispworks.com wrote:
The binding is there because the reader macro expansion passes X as an argument, as in (#:G1129 X). The setf expander is defined using DEFSETF, so it has to evaluate all of its arguments in left-to-right order by binding them to temporary variables.
It isn't clear to me why this argument is needed, because the DEFSETF form can access the variable directly.
OTOH, the uses of EVAL look strange and I suspect the whole thing could be written more clearly without needing a separate DEFMACRO and DEFSETF for each DEFACTIVE form. That approach would need to use DEFINE-SETF-EXPANDER instead of DEFSETF.
Thank you all for your input on this problem. I have reworked the code to remove the eval's (for some reason I thought they were needed). I also removed the parameter to the setf-handler, I guess I thought that you needed a parameter to the setf handler and didn't realize that the variable binding was already there. This was really just a thought experiment in macro programming to implement a feature of ksh, and as always, I am just learning. Here is the reworked code:
(set-macro-character #$ (lambda (stream char) (declare (ignore char)) (let ((v (read stream))) (list (get v 'setf-handler-name)))))
(defmacro defactive (var value &key write-handler read-handler) (let ((setf-handler-name (gensym))) `(progn (defparameter ,var ,value) (defmacro ,setf-handler-name () (let ((read-handler (gensym))) `(let ((,read-handler (get ',',var :read-handler))) (if ,read-handler (funcall ,read-handler ,',var) ,',var)))) (defsetf ,setf-handler-name () (new-val) (let ((write-handler (gensym))) `(let ((,write-handler (get ',',var :write-handler))) (when ,write-handler (funcall ,write-handler ,',var ,new-val)) (setf ,',var ,new-val)))) (setf (get ',var 'setf-handler-name) ',setf-handler-name) (setf (get ',var :write-handler) ,write-handler) (setf (get ',var :read-handler) ,read-handler) ,value)))
(defmacro setactive (var &key read-handler write-handler) `(progn (when ,read-handler (setf (get ',var :read-handler) ,read-handler)) (when ,write-handler (setf (get ',var :write-handler) ,write-handler))))
(defactive x 0 :write-handler (lambda (old-val new-val) (format t "old: ~A new: ~A" old-val new-val)) :read-handler (lambda (val) (format t "value: ~A" val) val)) ;(setactive x :read-handler (lambda (val) (format t "~A !!! ~A" val))) ;(setactive x :write-handler (lambda (old-val new-val) (format t "~A !!! ~A" old-val new-val)))
(defactive d6 (1+ (random 6)) :read-handler (lambda (val) (let ((old val)) (setf d6 (1+ (random 6))) old)))
I will look into understanding define-setf-expander to see how this could be improved. I'm just happy that it works and I could implement it at all...long live user programmable languages!
-- Burton Samograd http://kruhft.dyndns.org