高级符号宏

问题描述 投票:1回答:3

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

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

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

问题是,让我们说第一个和第二个是一些数字或nil。我们还要说,如果第二个是非nil,首先总是nil。现在,我可以将我的var绑定到只有一个宏的非nil吗?所以它只是查看给定的类的实例,然后检查第二个是nil。如果不是,它将var绑定到秒,否则先绑定。

看起来很复杂,但我很确定它可以做到,只是不知道从哪里开始。

为了进一步概括 - 是否可以将变量不是一个地方,而是一个特定的一个,取决于一些状态?

macros lisp common-lisp
3个回答
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扩展,让你在没有小助手功能的情况下做到这一点。您还可以使用全局辅助函数来传递一个对象和一个访问器列表来尝试使代码稍微小一点(尽管您可以在任何严肃的实现中通过声明内联函数来实现类似的小代码,这应该会导致它们成为完全编译完毕)。


另一种可能更好的方法是使用通用函数定义要实现的协议。这意味着事物是全局定义的,它与Kaz的答案有关但不完全相同。

再说一次,假设我有一些类(这可能是一个结构,但是使它成为一个完全成熟的standard-class让我们有未绑定的插槽,这很好):

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

现在您可以使用appropriate-slot-value(setf appropriate-slot-value)等名称定义泛型函数,也可以定义GF,它返回相应插槽的名称,如下所示:

(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
投票

使用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的副作用。然后将该临时变量指定为获取先前值的访问表单。


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
© www.soinside.com 2019 - 2024. All rights reserved.