In a previous post at Simplifying complex setf expressions, @sds suggested using the
get-setf-expansion macro for implementing place modification, as discussed in On Lisp (p171ff) by Paul Graham . In a related post at Destructive place-modifying operators, @acelent provides additional guidance. Based on their advice, I've written a place modifying macro (below), and would appreciate any comments, improvements, corrections, or error checking procedures. It has passed the preliminary tests I have performed. However, my experience with macros, is limited, and I know their workings can be subtle.
The macro is intended to perform (and return) an in-place modification based on an arbitrary common-lisp function. A simple example would be
(! 1+ @x) == (incf x). The ! signifies modification, and @ indicates the place being modified (and returned). A more complex example is
(! delete 3 @(car x) :test #'equal) == (setf (car x) (delete 3 (car x) :test #'equal)). I've had to include the @ marker for the place, since I can't think of another way to pass the place on to
(get-setf-expansion place). (Is there any way to analyze the features of the input function in order to zero in on the appropriate place argument?) Otherwise, Paul Graham's macro template (he calls it _f) seems to work, if you substitute
get-setf-expansion for his
(defmacro ! (fn &rest args) "Modifies an object at a place according to a given function. Obviates the need for some specialized macros--eg, (incf x) == (! 1+ @x); and generalizes place modification for standard common-lisp functions." (let* ((sym (find-if #'(lambda (arg) ;find the place argument signaled by @ (and (symbolp arg) (string= (aref (symbol-name arg) 0) "@"))) args)) (fn-args (cond ((eq sym '@) ;sym indicates a generalized reference (remove '@ args)) ((> (length (symbol-name sym)) 1) ;sym indicates a variable (subst (find-symbol (subseq (symbol-name sym) 1)) sym args)) (t (error "Modify macro call ~A is ill-formed." (cons '! (cons fn args)))))) (place (if (eq sym '@) (elt args (1+ (position '@ args))) ;generalized reference (find-symbol (subseq (symbol-name sym) 1))))) ;normal variable (multiple-value-bind (vars forms var set access) (get-setf-expansion place) ;(ut::prt fn args sym fn-args place vars forms var set access) (declare (ignore access)) `(let* (,@(mapcar #'list vars forms) (,(car var) (,fn ,@fn-args))) ,set))))