换句话说,是否可以像 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)))))
这也行不通。
最佳答案
因此,我们希望 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
关于macros - 是否可以使用符号宏来获得类似标签的行为?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/19928255/