通用Lisp的setf扩展：访问整数位的函数

Question

我正在使用Common Lisp编写一个程序，需要为数组中大量的条目存储一些状态位（整个程序基本上是将Fortran翻译为Lisp），状态位被编码为固定数字中的位数，这些数字均存储在这个数组中。这些状态位的访问器实际上将由宏定义，所以我不必关心分配这些位，但一个示例读取函数可能如下：

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

在现实生活中，这些内容会被内联并且充斥着声明，以尝试确保它的速度，但我认为这些在这里并不重要。

我需要将这些东西作为函数，因为我想能够对它们进行映射，而且使用宏来内联函数的方式让我感觉很糟糕。

然后我会像这样使用它：

(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 people ...）而不是（deadp aref ...），其中 people 是人员数组。这是可以的，而且很容易看出如何使其成为可 setf 的，但我还想能够说（deadp status），其中 status 只是一个fixnum。但也许有更好的方法。

- user5920214

---

这不是一个答案，而是“可能的替代方法”。使用位向量会减慢多少速度？需要多少更多的内存？至少SBCL可以有效地实现它们。 - Vatine

@Vatine：实际上我目前正在使用位向量！这里不是描述我试图做什么的正确位置，但通过在fixnum数组中存储信息，我希望能够使用专门的数组而不是通用数组或（因为我没有这样做）两个数组。 - user5920214

Answer 1

根据SBCL GET-SETF-EXPANSION文档，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))

- RowPJ

---

我想这就是了。我仍然不确定我是否正确理解了define-setf-expander（事实上，我确定我没有理解！），但这似乎可以工作。让我尝试使用它来检查我的代码是否正确：如果是的话，我稍后会接受答案。谢谢。 - user5920214