Question

我有这个宏

(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可以解决我的问题。

PS。这是我的第一个CL宏。

Answer 1

在大多数情况下，基本上有两种现有方法可以正常工作：改变容器（如散列表）或操纵不可变数据（如关联列表）。你要做的是改变关联列表，这有点难以正确实现并与预期用法相悖。但是仍然可以写一个宏，如下所示。

哈希表

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

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

请参阅MAKE-HASH-TABLE和GETHASH。

关联列表

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

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

请参阅ACONS。

上面，未修改现有环境。在前一个之上构建一个新的。它们都共享相同的子列表。假设您有一个名为process的函数，它接受一个值和一个环境，并且env已经绑定到一个环境，您可以调用：

 (process value (increase-priority env 1))

中间环境只在函数调用中可见，而env保持不变。您可以设法对哈希表执行相同操作，前提是您复制现有哈希表或处理撤消临时更改。

修改地点

您通常不希望修改关联列表：与哈希表不同，您没有可以轻松变异的单个容器。空关联列表是符号nil：您不能改变该空列表以添加新元素。绕过该问题的一种可能方法是保留一个保存关联列表头部的结构（这是下一节的内容）。另一种方法是使用宏，它可以接受表示绑定的评估表达式，更一般地说是 place ：如果变量env包含nil关联列表，则需要将env设置为新列表。另外，如您的示例所示，您可能会改变常量数据：您引用了列表，在Common Lisp中表示数据应该被视为常量;但后来你试图修改它，它有未定义的行为。

与PUSH一样，您的宏可以设置保存列表的位置。您可以使用DEFINE-SETF-EXPANDER定义自己的宏，如评论中所述：

(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。但是如果我们没有找到这样的利弊细胞，我们会在现有清单前面推出一个新的利弊细胞。无论哪种方式，代码都必须返回新的优先级（这是SETF合同的一部分）。这是一个例子：

(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 (get-priority list) 20)（在SBCL下）的宏观扩展：

(LET* ((#:G757 (ASSOC 'PRIORITY LIST)) (#:G758 20))
  (PROG1 #:G758
    (IF #:G757
        (SETF (CDR #:G757) #:G758)
        (SETF LIST (LIST* (CONS 'PRIORITY #:G758) LIST)))))

通过修改现有值设置get-priority时，将使用setf-expander返回的最后一个值。例如，以下表达式：

(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扩展。无论如何，如果你编写宏，请注意不需要的 mutliple评估：你的代码会评估todo两次。相反，使用GENSYM来定义局部变量，这些变量包含您只需要评估一次的表单值（或者，请参阅有趣的ONCE-ONLY宏）。

专用容器

您也可以将列表（nil或cons-cell）包装到容器中而不是宏：

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

然后，您可以根据需要改变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)))

但是，您可能还需要实现其他辅助函数，这在关联列表方面稍微不是惯用的。更喜欢以不可变的方式使用它们。

如何创建一个可以返回返回参数的表单或返回默认数字的表单的setf-able

1 个答案:

哈希表

关联列表

修改地点

专用容器