高级符号宏

时间:2019-04-08 09:55:59

标签: macros lisp common-lisp

假设我有一个类class,其插槽为firstsecond。在我的函数内部,我可以将变量绑定到其中一个插槽,例如

(symbol-macrolet ((var (first cls)))
 ....)

很显然,我也可以将第二个插槽绑定到smth。

问题是,假设第一和第二个是某个数字或nil。我们还要说,如果秒不是nil,则第一总是nil。现在,我可以只用一个宏将var绑定到非nil上吗?因此,它仅查看给定类的实例,然后检查秒是否为nil。如果不是,它将var绑定到第二个,否则绑定到第一个。

似乎很复杂,但是我很确定可以做到,只是不知道从哪里开始。

进一步概括一下-是否可以根据某个状态将变量绑定到一个位置,而不是绑定到单个位置?

3 个答案:

答案 0 :(得分:2)

我认为这不是很简单。您可以执行类似以下操作的操作,该操作仅适用于读取(我使用了伪造的toy结构,因此我的代码可以正常工作,在此处提供):

(defstruct toy
  (first nil)
  (second nil))

(defun foo (a-toy)
  (symbol-macrolet ((x (or (toy-first a-toy) (toy-second a-toy))))
    ...))

但是现在(setf x ...)绝对是非法的。通过定义一些局部函数,在确定(setf x ...)应该做什么之后,就可以解决此问题。我决定在这里设置非nil插槽,因为这对我来说很有意义。

(defun bar (a-toy)
  (flet ((toy-slot (the-toy)
           (or (toy-first the-toy) (toy-second the-toy)))
         ((setf toy-slot) (new the-toy)
           (if (toy-first the-toy)
               (setf (toy-first the-toy) new)
             (setf (toy-second the-toy) new))))
    (symbol-macrolet ((x (toy-slot a-toy)))
      (setf x 2)
      a-toy)))

现在您可以将它们全部包装在一个宏中:

(defmacro binding-toy-slot ((x toy) &body forms)
  (let ((tsn (make-symbol "TOY-SLOT")))
    `(flet ((,tsn (the-toy)
              (or (toy-first the-toy) (toy-second the-toy)))
             ((setf ,tsn) (new the-toy)
               (if (toy-first the-toy)
                   (setf (toy-first the-toy) new)
                 (setf (toy-second the-toy) new))))
       (symbol-macrolet ((,x (,tsn ,toy)))
         ,@forms))))

(defun bar (a-toy)
  (binding-toy-slot (x a-toy)
    (setf x 3)
    a-toy))

很显然,您可能想推广binding-toy-slot,因此,例如,它需要一个插槽访问器名称或类似名称的列表。

也许我没有想到过更好的方法:setf扩展可能有一些巧妙的技巧,使您可以在没有辅助功能的情况下进行操作。您还可以使用 global 辅助函数,该函数传递了一个对象,并尝试了一个访问器列表,这将使代码稍微小一些(尽管在任何严肃的实现中都可以通过声明辅助器来实现类似的小代码)内联,这将导致它们被完全编译掉。)


一种替代的方法,也许是更好的方法,是使用泛型函数定义要实现的协议。这意味着事物是全局定义的,它与Kaz的答案相关但不完全相同。

再说一遍,我有一些类(可以是一个结构,但是将其变成完整的standard-class可以让我们拥有未绑定的插槽,这很不错):

(defclass toy ()
  ((first :initarg :first)
   (second :initarg :second)))

现在,您可以使用诸如appropriate-slot-value(setf appropriate-slot-value)之类的名称来定义通用函数,或者您可以定义GF来返回相应插槽的名称,如下所示:< / p>

(define-condition no-appropriate-slot (unbound-slot)
  ;; this is not the right place in the condition heirarchy probably
  ()
  (:report "no appropriate slot was bound"))

(defgeneric appropriate-slot-name (object &key for)
  (:method :around (object &key (for ':read))
   (call-next-method object :for for)))

(defmethod appropriate-slot-name ((object toy) &key for)
  (let ((found (find-if (lambda (slot)
                          (slot-boundp object slot))
                        '(first second))))
    (ecase for
      ((:read)
       (unless found
         (error 'no-appropriate-slot :name '(first second) :instance object))
       found)
      ((:write)
       (or found 'first)))))

现在访问器函数对可以是普通函数,适用于任何有appropriate-slot-name方法的类:

(defun appropriate-slot-value (object)
  (slot-value object (appropriate-slot-name object :for ':read)))

(defun (setf appropriate-slot-value) (new object)
  ;; set the bound slot, or the first slot
  (setf (slot-value object (appropriate-slot-name object :for ':write)) new))

最后,我们现在可以使用以明显方式使用symbol-macrolet的函数:

(defun foo (something)
  (symbol-macrolet ((s (appropriate-slot-value something)))
    ... s ... (setf s ...) ...))

所以,这是另一种方法。

答案 1 :(得分:1)

使用defsetf的简单,低效的方式:

(defun second-or-first (list)
  (or (second list) (first list)))

(defun set-second-or-first (list val)
  (if (second list)
    (setf (second list) val)
    (setf (first list) val)))

(defsetf second-or-first set-second-or-first)

(defun test ()
  (let ((list (list nil nil)))
    (symbol-macrolet ((sof (second-or-first list)))
      (flet ((prn ()
               (prin1 list) (terpri)
               (prin1 sof) (terpri)))
        (prn)
        (setf sof 0)
        (prn)
        (setf sof 1)
        (prn)
        (setf (second list) 3)
        (prn)
        (setf sof nil)
        (prn)
        (setf sof nil)
        (prn)))))

如果可以将(incf sof)之类的更新表达式浪费两次遍历该结构,就足够了。

否则,需要使用define-setf-expander进行更复杂的实现。这种解决方案的要点在于,所生成的代码必须计算列表的两个cons单元中的哪个保持当前位置,并将该cons单元存储在临时变量#:temp中。然后,我们感兴趣的地方用(car #:temp)表示。如果#:temp是第二个单元格,则避免两次访问都是很棘手的(一次访问确定它是我们想要的一次,然后另一次获得先前的值)。基本上,我们可以做的是拥有另一个临时变量,该变量保存我们获得的场所的值,作为检查其是否为nil的副作用。然后,将该临时变量指定为获取先前值的访问形式。

答案 2 :(得分:0)

在这里,您可能会不付出任何巨大损失就不使用符号宏的方法:

(defgeneric firsty-secondy (thing))
(defgeneric (setf firsty-secondy) (newval thing))
(defmethod firsty-secondy ((x my-class))
  (or (secondy x) (firsty x)))
(defmethod (setf firsty-secondy) (nv (x my-class))
  (if (secondy x)
      (setf (secondy x) nv)
      (setf (firsty x) nv)))

您可能会发现编译器在这些方面做得更好,因为在方法中可以更加确定字段的插槽在内存中的位置。

这是一种构造对象的方法,不需要这样做,并且可以更好地执行不变式:

(defclass my-class
  ((is-first :initform nil)
   (thingy :initform nil)))

这里是一个比较:

first=nil,second=nil  :  is-first=nil,thingy=nil
first=123,second=nil  :  is-first=t  ,thingy=123
first=nil,second=123  :  is-first=nil,thingy=123
first=123,second=456  : unrepresentable