Common lisp 如何使setf成为一个宏，该宏将返回一个返回参数的窗体或一个返回默认数字的窗体

我有这个宏

(defmacro get-priority (todo)
  `(or (and (listp (car ,todo))
           (cdr (assoc 'priority ,todo)))
      0))

这就是所谓的那样

CL-USER> (get-priority '(Make stack overflow question))
0
CL-USER> (get-priority '((priority . 10)(Make stack overflow question)))
10

我需要能够设置

get priority

的结果。在调用宏结果返回默认值0的情况下，我只想设置一个临时位置。也许使用gensym可以解决我的问题

---

这是我的第一个CL宏。

基本上有两种现有方法在大多数情况下都能很好地工作：变异容器（如哈希表）或操纵不可变数据（如关联列表）。 您试图做的是改变关联列表，这使得正确实现有点困难，并且与预期用途背道而驰。但是，仍然可以编写宏，如下所示

哈希表 如果要修改属性，只需使用哈希表即可：

(gethash 'priority environment 0)
=> Either the current priority, or zero if no priority is set

(setf (gethash 'priority environment) 10)
=> Replaces priority

甚至：

(incf (gethash 'priority environment 0))
=> Increment current priority (which defaults to zero)

见和

关联列表 当您想要从其他环境快速继承值时，可以认为关联列表优于哈希表。 其工作方式是在列表中找到第一个匹配项，这意味着您可以多次出现

优先级

，其中第一个匹配项与其他匹配项相重叠

(defun increase-priority (environment value)
  (acons 'priority 
         (+ (or (cdr (assoc 'priority env)) 0)
            value)
         environment))

看

在上面的示例中，不修改现有环境。在前一个的基础上建造了一个新的。它们都共享同一个子列表。假设您有一个名为

process

的函数，它接受一个值和一个环境，并且

env

已经绑定到一个环境，您可以调用：

 (process value (increase-priority env 1))

中间环境只在函数调用内部可见，而

env

保持不变。 如果复制现有哈希表或撤消临时更改，则可以对哈希表执行相同的操作

修改位置 通常，您不想修改关联列表：与哈希表不同，您没有一个可以轻易改变的容器。空关联列表是符号

nil

：您不能通过修改该空列表来添加新元素。 绕过该问题的一种可能方法是保留一个结构，该结构保留关联列表的标题（这是下一节要做的）。 另一种方法是使用宏，它可以接受表示绑定的未赋值表达式，更一般地说是一个位置：如果变量

env

持有一个nil关联列表，则需要将

env

设置为新列表。此外，如您的示例所示，您有可能改变常量数据：您引用了您的列表，这在公共Lisp中意味着数据应被视为常量；但是你试图修改它，它有未定义的行为

例如，允许宏设置保存正在修改的列表的位置。您可以使用定义自己的宏，如注释中所述：

(define-setf-expander get-priority (list)
  (let ((current (gensym))
        (new-priority (gensym)))
    (values (list current)
            (list `(assoc 'priority ,list))
            (list new-priority)
            `(prog1 ,new-priority
               (if ,current
                   (setf (cdr ,current) ,new-priority)
                   (setf ,list
                         (list* (cons 'priority ,new-priority)
                                ,list))))
            `(if ,current (cdr ,current) 0)))) 

基本上，我们获取

'priority

位于

car

位置的现有cons单元，并替换其

cdr

。但是，如果我们没有找到这样一个cons单元，我们就会在现有列表前面推一个新的cons单元。无论哪种方式，代码都必须返回新的优先级（这是合同的一部分）。以下是一个例子：

(let ((list ()))
  (print list)
  (print (setf (get-priority list) 10))
  (print list)
  (print (setf (get-priority list) 20))
  (print list)
  (values))

上述印刷品：

NIL 
10 
((PRIORITY . 10)) 
20 
((PRIORITY . 20))

下面是

（setf（获取优先级列表）20）

（在SBCL下）的宏扩展：

当通过修改其现有值来设置

get priority

时，使用setf扩展器返回的最后一个值。例如，以下表达式：

(let ((list (list)))
  (incf (get-priority list)))

扩展为：

(LET ((LIST (LIST)))
  (LET* ((#:G771 (ASSOC 'PRIORITY LIST))
         (#:G772
          (+ 1
             (IF #:G771
                 (CDR #:G771)
                 0))))
    (LET ((#:G773 #:G772))
      (IF #:G771
          (SB-KERNEL:%RPLACD #:G771 #:G772)
          (SETQ LIST (LIST* (CONS 'PRIORITY #:G772) LIST)))
      #:G773)))

您可以看到变量

#：G772

是根据当前值计算得出的新值，该值从cons单元格中提取或默认为零。 请注意，在更复杂的地方使用扩展时也会起作用：

(let ((hash (make-hash-table)))
  (setf (gethash 'cons hash) (cons (list (cons 'priority 0)) :dummy))
  (setf (get-priority (car (gethash 'cons hash))) 100)
  (maphash (lambda (k v) (print v)) hash))

=> (((PRIORITY . 100)) . :DUMMY)

宏观扩张：

(LET* ((#:G759 (ASSOC 'PRIORITY (CAR (GETHASH 'CONS HASH)))) (#:G760 100))
  (LET ((#:G761 #:G760))
    (IF #:G759
        (SB-KERNEL:%RPLACD #:G759 #:G760)
        (SB-KERNEL:%RPLACA (GETHASH 'CONS HASH) (LIST* (CONS 'PRIORITY #:G760) (CAR (GETHASH 'CONS HASH)))))
    #:G761))

不建议您使用上述setf扩展。无论如何，如果您编写宏，请注意不需要的多重求值：您的代码求值

todo

两次。取而代之的是，使用定义局部变量，这些变量包含只需计算一次的表单值（或者，请参见有趣的宏）

专用集装箱 除了宏，您还可以将列表（nil或cons单元格）包装到容器中：

(defstruct (association-list
            (:constructor alist (&optional head))
            (:conc-name alist-))
  head)

然后，您可以根据需要修改

头
插槽

(defun aget (alist property &optional default)
  (etypecase alist
    (null default)
    (cons (let ((result (assoc property alist)))
            (if result
                (values (cdr result) result)
                default)))
    (association-list
     (aget (alist-head alist) property default))))

(defmacro apush (key value alist)
  `(push (cons ,key ,value) (alist-head ,alist)))

(defun (setf aget) (value alist property)
  (let ((existing (assoc property (alist-head alist))))
    (prog1 value
      (if existing
          (setf (cdr existing) value)
          (apush property value alist)))))

例如：

(let ((alist (alist)))
  (print (aget alist 'priority 0))
  (print (setf (aget alist 'priority) 10))
  (print alist)
  (print (setf (aget alist 'priority) 20))
  (print alist)
  (values))

。。。印刷品：

0 
10 
#S(ASSOCIATION-LIST :HEAD ((PRIORITY . 10))) 
20 
#S(ASSOCIATION-LIST :HEAD ((PRIORITY . 20)))

然而，您可能还需要实现额外的helper函数，当涉及关联列表时，这有点不习惯。更喜欢以不变的方式使用它们。
您可以使用一个
GET-PRIORITY
函数，该函数可以返回一个默认值，并定义一个
（SETF GET-PRIORITY）
（注意，在Common Lisp中这是一个合法的函数名）函数来执行任何您想要的操作。或者，您也可以看到，您通常无法设置结果。SETF用于设置位置。一个地方不是一个物理的东西，但更像是一个概念来概括设置事物的方式。一般来说，一个位置可能看起来像一个访问器，但它实际上是SETF计算setter所用的描述。在
（setf（foo-bar）：baz）
setf不设置
（foo-bar）
的结果，但它在宏扩展时间（！）查看表单
（foo-bar）
本身以计算setter代码。然后执行这个新代码。
0 
10 
#S(ASSOCIATION-LIST :HEAD ((PRIORITY . 10))) 
20 
#S(ASSOCIATION-LIST :HEAD ((PRIORITY . 20)))