6
\$\begingroup\$

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 get-setf-method.

(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))))
\$\endgroup\$

migrated from stackoverflow.com Feb 16 '17 at 20:22

This question came from our site for professional and enthusiast programmers.

  • \$\begingroup\$ acelent's answer to my question works for me. Should I still copy & paste it, for educational purposes, in Code Review, in case it might provide guidance for someone else on the get-setf-extension topic, or just let it expire? Also, is one question every few days excessive for Stack Overflow? \$\endgroup\$ – davypough Feb 16 '17 at 18:31
  • \$\begingroup\$ (regarding the votes to put on hold as off-topic) Parts of this question are on-topic, such as how to use get-setf-expansion properly. Also, since there was already an answer, you could have reconsidered not voting to put the question on hold. \$\endgroup\$ – acelent Feb 16 '17 at 18:38
  • \$\begingroup\$ @davypough, you may ask as many questions in as little time frame you wish, as long as they're good questions. You can try rewording this question in such a way that it doesn't sound like "here's my code, what do you think?", but to sound like "I want to achieve X, I've done Y but it seems/works wrong, how can it be improved/solved?" \$\endgroup\$ – acelent Feb 16 '17 at 18:40
3
\$\begingroup\$

First things first, you should know about the order of evaluation in modifying forms:

(operator preceding-form* place following-form*)

The evaluation of each such form proceeds like this:

  1. Evaluate each of the preceding-forms, in left-to-right order.

  2. Evaluate the subforms of the place, in the order specified by the second value of the setf expansion for that place.

  3. Evaluate each of the following-forms, in left-to-right order.

  4. Read the old value from place.

  5. Compute the new value.

  6. Store the new value into place.

I'll take your idea with these changes:

  • Instead of !, I'll call it updatef

  • Instead of @, I'll use an identifying form, (:place <place>), where <place> is the actual place

  • Instead of splashing the form (e.g. (updatef delete 2 (:place *x*))), I'll make it a single destructuring argument of the macro (e.g. (updatef (delete 2 (:place *x*))))

I'm aware that this syntax is more verbose, but due to the specific nature of updatef's behavior, I think it shouldn't be used just about anywhere.

(defmacro updatef ((&whole form function &rest args) &environment env)
  (flet ((is-place-form (arg)
           (and (consp arg)
                (eq (card arg) :place)
                (consp (cdr arg)))))
    (let ((place-rest (member-if #'is-place-form args)))
      (assert (not (null place-rest)) ()
              "No place form in updatef.")
      (assert (null (member-if #'is-place-form (rest place-rest))) ()
              "More than one place form in updatef.")
      (let* ((preceding-forms (ldiff args place-rest))
             (place (second (first place-rest)))
             (following-forms (rest place-rest))
             (preceding-vars (loop for preceding-form in preceding-forms collect (gensym "preceding-var")))
             (following-vars (loop for following-form in following-forms collect (gensym "following-var"))))
        (multiple-value-bind (vars vals store-vars writer-form reader-form)
            (get-setf-expansion place env)
          (assert (= (length vars) (length vals)) ()
                  "Place expansion has different amount of variables than initializing forms in updatef.")
          `(let* (,@(mapcar #'(lambda (var form)
                                `(,var ,form))
                            (append preceding-vars vars following-vars)
                            (append preceding-forms vals following-forms)))
             (multiple-value-bind (,@store-vars)
                 (,function ,@preceding-vars ,reader-form ,@following-vars)
               ,writer-form)))))))

One of the good things that this macro does is to evaluate the subforms only once. However, it doesn't help with certain kinds of places where it would be useful to operate atomically, such as setf of gethash or implementation specific atomic operations on places.


Here's a more permissive version that allows certain errors from setf expansions, namely: more or less vars than vals and a writer-form that doesn't return the new value(s).

Also, I made it so it does nothing special (regarding setf behavior) in case no form is (:place <place>), and to use the first such form in case there are more than one.

(defmacro updatef ((&whole form function &rest args) &environment env)
  (flet ((is-place-form (arg)
           (and (consp arg)
                (eq (card arg) :place)
                (consp (cdr arg)))))
    (let ((place-rest (member-if #'is-place-form args)))
      (cond ((null place-rest)
             (warn "No place form in updatef, no update generated.")
             form)
            (t
             (when (not (null (member-if #'is-place-form (rest place-rest))))
               (warn "More than one place form in updatef, first place will be used."))
             (let* ((preceding-forms (ldiff args place-rest))
                    (place (second (first place-rest)))
                    (following-forms (rest place-rest))
                    (preceding-vars (loop for preceding-form in preceding-forms collect (gensym "preceding-var")))
                    (following-vars (loop for following-form in following-forms collect (gensym "following-var"))))
               (multiple-value-bind (vars vals store-vars writer-form reader-form)
                   (get-setf-expansion place env)
                 (when (not (= (length vars) (length vals)))
                   (warn "Place expansion has different amount of variables than initializing forms in updatef."))
                 `(let* (,@(mapcar #'(lambda (var form)
                                       `(,var ,form))
                                   preceding-vars preceding-forms)
                         ,@(mapcar #'(lambda (var form)
                                       `(,var ,form))
                                   vars vals)
                         ;; In case there are more vars than vals
                         ,@(nthcdr (length vals) vars))
                    ;; In case there are more vals than vars
                    ,@(nthcdr (length vars) vals)
                    (let* (,@(mapcar #'(lambda (var form)
                                         `(,var ,form))
                                     following-vars following-forms))
                      (multiple-value-bind (,@store-vars)
                          (,function ,@preceding-vars ,reader-form ,@following-vars)
                        ,writer-form
                        ;; In case writer-form doesn't return the new value(s)
                        (values ,@store-vars)))))))))))

I'm sure that if you try, you can find many more places where to check for errors and warnings, and decide if you're permissive about them or not. It has been quite a while since I've played with places myself.

\$\endgroup\$
  • \$\begingroup\$ It still would be instructive for me to see which specific place forms do not work for !. Digestion commencing... \$\endgroup\$ – davypough Feb 16 '17 at 18:32
  • \$\begingroup\$ Regarding correctness, your expansion evaluates the place's subforms more than once, with probably unintended side-effects, e.g. (! 1+ @(gethash (random 10) (next-hash-table))) where both (random 10) and an hypothetical (next-hash-table) will run twice; also, ! doesn't support multiple valued places. Regarding other qualities, ! has a dichotomy between symbols that start with @ and forms that look like @(...) but are actually preceded by a symbol named @, while in updatef it's always (:place ...); updatef forms are way more readable, at the cost of verbosity. \$\endgroup\$ – acelent Feb 16 '17 at 19:14
  • \$\begingroup\$ From experience, most often, you don't need updatef at all. For variables, (setf var (something-with var)) is really easier to understand; for the much rarer cases where you have a place and you don't want to evaluate its subforms more than once, just surround the setf with a let that evaluates them into variables and use these variables in the place's subforms. If you find yourself using such macros all over code that you intend to share, I suggest you step back for a while and evaluate such practice. \$\endgroup\$ – acelent Feb 16 '17 at 19:22
  • \$\begingroup\$ If I'm understanding this right, the crux of the problem with ! is multiple evaluations of the place subforms (setting aside multiple valued places for now). Doesn't setf have the same issue, which, as you point out in your gethash example, could be overcome by first leting the appropriate subforms? I wouldn't expect ! to have more power than setf, since ! is based on get-setf-expansion. Can you think of another failing example unique to !? (ps: it's satisfying just to be able to pose questions like these now based on your most excellent discussion!) \$\endgroup\$ – davypough Feb 17 '17 at 19:09
  • \$\begingroup\$ Regarding multiple values, how can a setf accessor refer to multiple values? Normally, I think of a place as containing one object, which can be accessed via an accessor form. But then an accessor is also a function call(?), which can return multiple values. Is there an arranged marriage here? \$\endgroup\$ – davypough Feb 17 '17 at 19:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.