macros - 是否可以使用符号宏来获得类似标签的行为？

Question

换句话说，是否可以像 flet 或 labels 那样在本地定义一个函数？我的最终目标是拥有一个类似于 labels 的宏，它使用 funcallable-standard-class 的实例而不是常规函数，而不必使用 funcall。用例可能如下所示:

(funcallable-let ((foo func-class :initargs ...))
  (foo ...))

symbol-macrolet 似乎只有在不在头部位置时才会展开。如果我尝试 (setf (symbol-function 'foo) (make-instance 'some-funcallable-class)) 这会将它全局设置为这个符号而不是封闭 let 的范围。

---

这是到目前为止我能得到的(但它不起作用，因为 macrolet 在这种情况下不会扩展......)

(defclass func ()
  ((state :initarg :state :accessor state-of))
  (:metaclass sb-mop:funcallable-standard-class))

(defmethod initialize-instance :after ((this func) &rest initargs)
  (declare (ignore initargs))
  (sb-mop:set-funcallable-instance-function
   this (lambda ()
          (format t "~&I am: ~s, my state is: ~s" this (state-of this)))))

(defmacro funcallable-let (bindings &body body)
  (loop :for binding :in bindings
     :for name := (car binding)
     :for class := (cadr binding)
     :for init-args := (cddr binding)
     :collect `(,name (make-instance ',class ,.init-args)) :into classes
     :collect `(,name (&rest args) (list 'apply '',name args)) :into macrolets
     :collect name :into ignorables
     :finally
     (return
       `(let ,classes
          (declare (ignorable ,@ignorables))
          (macrolet ,macrolets
            ,@body)))))

(defun test-funcallable-let ()
  (funcallable-let ((f func :state :f-state)
                    (g func :state :g-state))
    (f) (funcall 'g)))

---

这是对 Lars 的 Brinkoff 宏进行了一些修改:

(defmacro funcallable-let (bindings &body body)
  (loop
     :for binding :in bindings
     :for symbol := (gensym)
     :for name := (car binding)
     :for class := (cadr binding)
     :for init-args := (cddr binding)
     :collect `(,symbol (make-instance ',class ,.init-args)) :into lets
     :collect `(,name (&rest args) (apply ',symbol args)) :into flets
     :collect symbol :into ignorables
     :finally
     (return
       `(let ,lets
          (declare (ignorable ,@ignorables))
          (flet ,flets ,@body)))))

这也行不通。

Answer 1

因此，我们希望 f 的值成为 funcallable 对象，这样 (setf (state-of f) new-state) 就可以工作了，但是也是 f 的宏定义，因此 (f 1 2 3) 扩展为 (funcall f 1 2 3)。我们先写一些直接的代码。首先，您的 func 定义，但具有稍微不同的 funcallable 实例函数，以便我们可以传递一些参数并查看它们是什么:

(defclass func ()
  ((state :initarg :state :accessor state-of))
  (:metaclass sb-mop:funcallable-standard-class))

(defmethod initialize-instance :after ((this func) &rest initargs)
  (declare (ignore initargs))
  (sb-mop:set-funcallable-instance-function
   this (lambda (&rest args)
          (format t "~&I am: ~s, my state is: ~s, my args were ~s" this (state-of this) args))))

然后，我们可以编写我们希望 funcallable-let 扩展到的代码。如输出所示，头部位置的 f 最终成为对 funcallable 实例的调用，但非头部位置的 f 是一个具有 funcallable 实例的变量一个值，所以你可以，例如，(setf (state-of f) new-state):

(let ((f (make-instance 'func :state 34)))
  (macrolet ((f (&rest args)
               `(funcall f ,@args)))
    (f 1 2 3)
    (setf (state-of f) 89)
    (f 4 5 6)))

; I am: #<FUNC {1002A0B329}>, my state is: 34, my args were (1 2 3)
; I am: #<FUNC {1002A0B329}>, my state is: 89, my args were (4 5 6)

这看起来不错。现在我们只需要将它宏化:

(defmacro funcallable-let (bindings &body body)
  `(let (,@(loop :for (name . initargs) :in bindings
             :collect `(,name (make-instance 'func ,@initargs))))
     (macrolet (,@(loop :for (name . initargs) :in bindings
                    :collect `(,name (&rest args)
                                     `(funcall ,',name ,@args))))
       ,@body)))

宏展开看起来是对的:

CL-USER> (pprint (macroexpand '(funcallable-let ((f :state 34))
                                (f 1 2 3))))

(LET ((F (MAKE-INSTANCE 'FUNC :STATE 34)))
  (MACROLET ((F (&REST ARGS)
               `(FUNCALL F ,@ARGS)))
    (F 1 2 3)))

行为似乎是正确的(您可以使用 (f ...) 或使用 (funcall f ...) 调用，并且您可以 ( setf (state-of f) ...):

CL-USER> (funcallable-let ((f :state 34))
           (f 1 2 3)
           (setf (state-of f) 89)
           (f 4 5 6)
           (setf (state-of f) 62)
           (funcall f 7 8 9))
I am: #<FUNC {1002BEC389}>, my state is: 34, my args were (1 2 3)
I am: #<FUNC {1002BEC389}>, my state is: 89, my args were (4 5 6)
I am: #<FUNC {1002BEC389}>, my state is: 62, my args were (7 8 9)
NIL