Advanced symbol-macrolet

Question

Suppose I have a class class with slots first and second. Inside my function I can bind a variable to one of those slots like

(symbol-macrolet ((var (first cls)))
 ....)

Obviously I can also bind the second slot to smth.

Questions is, let's say that first and second are either some number or nil. Let's also say that if second is non-nil, first is always nil. Now, can I bind my var to a non-nil one with just one macro? So it just looks at instance of the class given and then check if second is nil. If no, it binds var to second, otherwise to first.

Seems complicated, but I'm pretty sure it can be done, just don't know where to start.

To further generalize -- is it possible to bond a variable not to a single place, but to one of a specific set, depending on some state?

Answer 1

Here’s how you might not use symbol macros without any huge loss:

(defgeneric firsty-secondy (thing))
(defgeneric (setf firsty-secondy) (newval thing))
(defmethod firsty-secondy ((x my-class))
  (or (secondy x) (firsty x)))
(defmethod (setf firsty-secondy) (nv (x my-class))
  (if (secondy x)
      (setf (secondy x) nv)
      (setf (firsty x) nv)))

You may find that the compiler does better with these because within the methods it can be more sure about where the slots for the fields are in memory.

Here is a way to structure your object to not need to do this and enforce your invariant a bit better:

(defclass my-class
  ((is-first :initform nil)
   (thingy :initform nil)))

Here is a comparison:

first=nil,second=nil  :  is-first=nil,thingy=nil
first=123,second=nil  :  is-first=t  ,thingy=123
first=nil,second=123  :  is-first=nil,thingy=123
first=123,second=456  : unrepresentable

Answer 2

I think this is not quite simple. You could do something like this which works for reading only (I've used a fake toy structure so my code works, which is given here):

(defstruct toy
  (first nil)
  (second nil))

(defun foo (a-toy)
  (symbol-macrolet ((x (or (toy-first a-toy) (toy-second a-toy))))
    ...))

But now (setf x ...) is horribly illegal. You can get around this, once you've decided what (setf x ...) should do, by defining some local functions. I've decided here that it should set the non-nil slot, as that makes sense to me.

(defun bar (a-toy)
  (flet ((toy-slot (the-toy)
           (or (toy-first the-toy) (toy-second the-toy)))
         ((setf toy-slot) (new the-toy)
           (if (toy-first the-toy)
               (setf (toy-first the-toy) new)
             (setf (toy-second the-toy) new))))
    (symbol-macrolet ((x (toy-slot a-toy)))
      (setf x 2)
      a-toy)))

And now you can wrap this all in a single macro:

(defmacro binding-toy-slot ((x toy) &body forms)
  (let ((tsn (make-symbol "TOY-SLOT")))
    `(flet ((,tsn (the-toy)
              (or (toy-first the-toy) (toy-second the-toy)))
             ((setf ,tsn) (new the-toy)
               (if (toy-first the-toy)
                   (setf (toy-first the-toy) new)
                 (setf (toy-second the-toy) new))))
       (symbol-macrolet ((,x (,tsn ,toy)))
         ,@forms))))

(defun bar (a-toy)
  (binding-toy-slot (x a-toy)
    (setf x 3)
    a-toy))

Obviously you might want to generalise binding-toy-slot, so it, for instance, takes a list of slot accessor names or something like that.

There may also be better ways of doing this I haven't thought of: there might be clever tricks with setf-expansions that let you do it without the little helper functions. You could also have global helper functions which get passed an object and a list of accessors to try which would make the code slightly smaller (although you can probably achieve similarly small code in any serious implementation by declaring the helpers inline which should cause them to be completely compiled away).

---

An alternative, and perhaps better, approach, is to define the protocol you want to achieve using generic functions. This means things are defined globally, and it's related to but not quite the same as Kaz's answer.

So again, let's say I have some class (this can be a structure, but making it a fully-fledged standard-class lets us have unbound slots, which is nice):

(defclass toy ()
  ((first :initarg :first)
   (second :initarg :second)))

Now you could either define generic functions with names like appropriate-slot-value & (setf appropriate-slot-value), or you could define GF which returns the name of the appropriate slot, like so:

(define-condition no-appropriate-slot (unbound-slot)
  ;; this is not the right place in the condition heirarchy probably
  ()
  (:report "no appropriate slot was bound"))

(defgeneric appropriate-slot-name (object &key for)
  (:method :around (object &key (for ':read))
   (call-next-method object :for for)))

(defmethod appropriate-slot-name ((object toy) &key for)
  (let ((found (find-if (lambda (slot)
                          (slot-boundp object slot))
                        '(first second))))
    (ecase for
      ((:read)
       (unless found
         (error 'no-appropriate-slot :name '(first second) :instance object))
       found)
      ((:write)
       (or found 'first)))))

And now the accessor function pair can be plain functions which will work for any class where there is a method for appropriate-slot-name:

(defun appropriate-slot-value (object)
  (slot-value object (appropriate-slot-name object :for ':read)))

(defun (setf appropriate-slot-value) (new object)
  ;; set the bound slot, or the first slot
  (setf (slot-value object (appropriate-slot-name object :for ':write)) new))

Finally, we can now have functions which just use symbol-macrolet in the obvious way:

(defun foo (something)
  (symbol-macrolet ((s (appropriate-slot-value something)))
    ... s ... (setf s ...) ...))

So, that's another approach.

Answer 3

Simple, inefficient way with defsetf:

(defun second-or-first (list)
  (or (second list) (first list)))

(defun set-second-or-first (list val)
  (if (second list)
    (setf (second list) val)
    (setf (first list) val)))

(defsetf second-or-first set-second-or-first)

(defun test ()
  (let ((list (list nil nil)))
    (symbol-macrolet ((sof (second-or-first list)))
      (flet ((prn ()
               (prin1 list) (terpri)
               (prin1 sof) (terpri)))
        (prn)
        (setf sof 0)
        (prn)
        (setf sof 1)
        (prn)
        (setf (second list) 3)
        (prn)
        (setf sof nil)
        (prn)
        (setf sof nil)
        (prn)))))

If it is okay that update expressions like (incf sof) wastefully traverse the structure twice, this is adequate.

Otherwise a more sophisticated implementation is required using define-setf-expander. The gist of such a solution is that the generated code has to calculate which of the two cons cells of the list holds the current place, storing that cons cell in a temporary variable #:temp. Then the place we are interested in is denoted by (car #:temp). If #:temp is the second cell, avoiding two accesses to are tricky (one access to determine it's the one we want, then the other to get the prior value). Basically what we can do is have another temp variable which holds the value of the place that we obtained as a side effect of checking whether it is not nil. Then designate that temporary variable as the access form for getting the prior value.