3

换句话说，是否有可能以类似于“如何”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。

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

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

这也行不通。

4

3 回答 3

4

所以，我们希望 的值是f可调用的对象，这样就可以(setf (state-of f) new-state)工作，而且还需要一个宏定义f，以便(f 1 2 3)扩展为(funcall f 1 2 3)。让我们先写一些直接的代码。首先，您的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扩展的代码。如输出所示，f在头部位置最终是对可调用实例的调用，但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) ...)：

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
于 2013-11-12T16:46:06.403 回答
1

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

(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 ...))
于 2013-11-12T12:45:54.143 回答
1

对于类似的问题，请参阅CLtL2GENERIC-FLET以及GENERIC-LABELS它在 ANSI Common Lisp 中被删除的原因。

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

于 2013-11-12T16:06:22.710 回答