高级符号宏

Question

假设我有一个类class 带有插槽first 和second。在我的函数中，我可以将变量绑定到其中一个插槽，例如

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

显然我也可以将第二个插槽绑定到smth。

问题是，假设第一个和第二个是某个数字或nil。假设第二个不是nil，那么第一个总是nil。现在，我可以只用一个宏将我的 var 绑定到非nil 吗？所以它只查看给定类的实例，然后检查第二个是否为nil。如果否，则将var 绑定到第二个，否则绑定到第一个。

看起来很复杂，但我很确定它可以完成，只是不知道从哪里开始。

进一步概括——是否可以将变量绑定到一个特定的位置而不是一个特定的位置，具体取决于某个状态？

Answer 1

我认为这不是很简单。你可以做这样的事情，它只适用于阅读（我使用了一个假的 toy 结构，所以我的代码可以工作，这里给出）：

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

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

但是现在(setf x ...) 是非常非法的。一旦你决定了(setf x ...) 应该做什么，你就可以通过定义一些本地函数来解决这个问题。我在这里决定它应该设置非nil 插槽，因为这对我来说很有意义。

(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)))

现在您可以将这一切包装在一个宏中：

(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))

显然，您可能想要概括 binding-toy-slot，因此它例如采用插槽访问器名称或类似名称的列表。

可能还有我没有想到的更好的方法：setf-expansions 可能有一些巧妙的技巧，可以让你在没有小辅助函数的情况下做到这一点。您还可以拥有 global 辅助函数，这些辅助函数通过一个对象和一个访问器列表来尝试，这将使代码稍微小一些（尽管您可以通过声明辅助函数在任何严肃的实现中实现类似的小代码inline 应该会导致它们被完全编译掉）。

---

另一种可能更好的方法是定义您想要使用泛型函数实现的协议。这意味着事物是全局定义的，它与 Kaz 的答案相关但并不完全相同。

再说一次，假设我有一些类（这可以是一个结构，但将其设置为成熟的 standard-class 可以让我们拥有未绑定的插槽，这很好）：

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

现在您既可以定义名称为appropriate-slot-value 和(setf appropriate-slot-value) 的通用函数，也可以定义返回相应槽的名称 的GF，如下所示：

(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)))))

现在访问函数对可以是普通函数，适用于任何有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))

最后，我们现在可以拥有只使用symbol-macrolet 的函数：

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

所以，这是另一种方法。

Answer 2

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)))))

如果像(incf sof) 这样的更新表达式可以浪费地遍历结构两次，这就足够了。

否则需要使用define-setf-expander 进行更复杂的实现。这种解决方案的要点是生成的代码必须计算列表的两个 cons 单元中的哪一个保存当前位置，并将该 cons 单元存储在临时变量#:temp 中。然后我们感兴趣的地方用(car #:temp)表示。如果#:temp 是第二个单元格，那么避免两次访问是很棘手的（一次访问确定它是我们想要的，然后另一个获得先验值）。基本上我们可以做的是有另一个临时变量，它保存我们获得的位置的值，作为检查它是否不是nil 的副作用。然后将该临时变量指定为获取先验值的访问形式。

Answer 3

以下是您可能不使用符号宏而不会有任何巨大损失的方法：

(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)))

您可能会发现编译器在这些方面做得更好，因为在方法中它可以更确定字段的插槽在内存中的位置。

这是一种构造你的对象的方法，不需要这样做并更好地执行你的不变量：

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

这是一个比较：

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