我有这个宏
(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宏。
答案 0 :(得分:3)
在大多数情况下,基本上有两种现有方法可以正常工作:改变容器(如散列表)或操纵不可变数据(如关联列表)。 你要做的是改变关联列表,这有点难以正确实现并与预期用法相悖。但是仍然可以写一个宏,如下所示。
如果要修改属性,只需使用哈希表:
(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)
当您想要快速从其他环境继承值时,可以认为关联列表优于哈希表。
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)))
但是,您可能还需要实现其他辅助函数,这在关联列表方面稍微不是惯用的。更喜欢以不可变的方式使用它们。