访问整数位的函数的 Common Lisp setf 扩展

Question

我正在用 Common Lisp 编写一个程序，它需要为数组中的大量条目存储一堆状态位（整个程序几乎是 fortran-in-lisp），并且状态位被编码为位于此数组中的 fixnum 中的位。这些状态位的访问器实际上将由宏定义，因此我不必关心分配位，但示例读取器函数可能是

(defun deadp (e)
  (logbitp 0 e))

（在现实生活中，这将被内联并杂乱无章地声明以确保它很快，但我认为这些在这里并不重要。）

我需要这些东西成为函数，因为我希望能够映射它们，但也因为 using-a-macro-to-inline-a-function 让我感觉很糟糕。

然后我会像这样使用它：

(defconstant status-index 3)
...
(dotimes (i nentries)
  (unless (deadp (aref entries i status-index))
    ...))

（在现实生活中(aref entries i status-index) 将是(status entries i)，这反过来又需要setf 方法，但我认为这很容易。）

或

(loop for i below nentries
      counting (if (deadp entries i status-index) 1 0))

当然还会有其他类似的单位标志，它们会有不同的位与之关联。

所以，现在我希望能够做到这一点：

(dotimes (i nentries)
  ...
  (when ...
    (setf (deadp (aref entries i status-index) t)))
  ...)

应该变成相当于

的代码

(dotimes (i nentries)
  ...
  (when ...
    (progn 
      (setf (ldb (byte 1 0) (aref entries i status-index)) 1)
      t))
  ...)

还有这个：

(let ((status 0))
  ...
  (when ...
    (setf (deadp status) t))
  ...)

这应该变成与此等效的代码：

(let ((status 0))
  ...
  (when ...
    (progn
      (setf (ldb (byte 1 0) status) 1)
      t))
  ...)

换句话说，我希望我的deadp 函数成为一个访问器，并且它上面的setf 可以以一般方式工作：(setf (deadp (cdr x)) nil) 应该可以工作，等等。

所以这让我陷入了我长期以来一直避免使用的 CL 中：定义 setf 扩展器。很明显，仅仅定义一个(setf deadp) 函数是行不通的，因为数字是不可变的，我相当确定defsetf 不够强大，所以我需要define-setf-expander，我不需要不明白。

有人可以解释我需要怎么做吗？我认为特定的 deadp 函数并不重要，尽管我关心的所有函数看起来都像是它的变体。

---

另一种答案是“这是一种脑残的方法，而不是……”，我对这些持开放态度。我考虑过编写将数组抽象出来的代码，所以我不会写(deadp (aref ...))，而是写(deadp people ...)，其中people 是人​​的数组。这很好，很容易看出如何使setfable，除了我还想能够说(deadp status)，其中status 只是一个固定数字。但也许有更好的方法。

Answer 1

根据 GET-SETF-EXPANSION 的 SBCL 文档，setf 扩展器必须： “返回 SETF 机器所需的五个值：临时列表 变量，用于填充它们的值列表，临时变量列表 用于新值、设置功能和访问功能。" 设置函数和访问函数实际上只是在该处设置和访问值的形式，而不是函数对象。

试试这个：

(define-setf-expander deadp (place)
  (let ((new (gensym)))
    (values nil nil (list new)
            `(progn (setf (ldb (byte 1 0) ,place) (if ,new 1 0))
                    ,new)
            `(deadp ,place))))

样本扩展：

(let ((status 1))
  (setf (deadp status) t))
->
(let ((status 1))
  (LET* ((#:G605 T))
    (SETF (LDB (BYTE 1 0) STATUS)
            (IF #:G605
                1
                0))
    #:G605))