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的值是可操作的对象，因此像(setf (state-of f) new-state)这样的东西可以工作，但也是f的宏定义，因此{{1} }扩展为(f 1 2 3)。我们先写一些直接代码。首先，你的(funcall f 1 2 3)定义，但有一个稍微不同的funcallable实例函数，以便我们可以传入一些参数并查看它们是什么：

func

然后，我们可以编写我们希望(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最终是对funcallable实例的调用，但非头部位置的f是一个将funcallable实例作为值的变量，因此您可以例如，f：

(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) ...)

Answer 2

我不确定你要做什么，但也许这个？

(defmacro funcallable-let (bindings &body body)
  (let ((gensyms (loop repeat (length bindings) collect (gensym))))
    `(let ,(loop for (name value) in bindings and g in gensyms
                 collect `(,g ,value))
       (flet ,(loop for (name value) in bindings and g in gensyms
                    collect `(,name (&rest args) (apply ,g args)))
         ,@body))))

样本用法：

(funcallable-let ((foo (make-instance 'some-funcallable-class :initargs ...)))
  (foo ...))

Answer 3

对于类似的问题，请参阅CLtL2的GENERIC-FLET和GENERIC-LABELS以及为什么在ANSI Common Lisp中将其删除。

http://www.lispworks.com/documentation/HyperSpec/Issues/iss181_w.htm

是否可以使用symbol-macrolet来获得类似标签的行为？

3 个答案: