如何使用函数（或闭包）对象设置局部函数定义？答案

【问题标题】：How to set local function definition using function (or closure) objects?如何使用函数（或闭包）对象设置局部函数定义？
【发布时间】：2013-08-21 15:48:27
【问题描述】：

flet 的问题是其中绑定的函数必须内联定义。换句话说，没有办法做到这一点：

(new-flet ((a (lambda (f x)
                (funcall f (* x 2))))
           (b (function-generator)))
    (a #'b 10))

我考虑自己定义这样一个宏，但问题是flet 似乎是唯一设置局部函数值的方法。 symbol-function 始终只获取全局定义，function 不能与 setf 一起使用。如果有的话，任何人都知道如何相当干净地完成这项工作？

【问题讨论】：

我想你忘了labels。
我没有忘记labels。我的问题与相互递归的函数绑定没有任何关系。同样的问题也适用于flet 和labels。
对不起，我猜我太习惯 Scheme 了。
我不明白你的问题是什么。您是否希望能够在不使用 flet 的情况下覆盖该函数范围之外的函数内部的函数调用？ Let 和 funcall 是您要找的吗？

标签： lisp common-lisp

【解决方案1】：

您可以轻松搭建蹦床

(defun function-generator (x)
  (lambda (y) (* x y)))

(let ((fg (function-generator 42)))
  (flet ((a (f x) (funcall f (* x 2)))
         (b (x) (funcall fg x)))
    (a #'b 10)))

使用这种方法的new-flet 的宏实现是

(defmacro new-flet (bindings &body body)
  (let ((let-bindings (list))
        (flet-bindings (list))
        (args (gensym)))
    (dolist (binding bindings)
      (let ((name (gensym)))
        (push `(,name ,(second binding))
              let-bindings)
        (push `(,(first binding) (&rest ,args)
                 (apply ,name ,args))
              flet-bindings)))
    `(let ,(nreverse let-bindings)
       (flet ,(nreverse flet-bindings)
         ,@body))))

在您的示例中扩展为

(macroexpand-1 '(new-flet ((a (lambda (f x) (funcall f (* x 2))))
                           (b (function-generator)))
                  (a #'b 10)))

==> (LET ((#:G605 (LAMBDA (F X)
                    (FUNCALL F (* X 2))))
          (#:G606 (FUNCTION-GENERATOR)))
      (FLET ((A (&REST #:G604)
               (APPLY #:G605 #:G604))
             (B (&REST #:G604)
               (APPLY #:G606 #:G604)))
        (A #'B 10)))

【讨论】：

MAKE-sYMBOL 可能更可取。依靠。同样在这里，也可以为新的&rest 变量声明dynamic-extent。 Lisp 或许可以利用这一点。
太棒了。我担心这是不可能的，因为我认为宏必须将(a ...) 的每个实例转换为(funcall a ...)（例如，当(a ...) 本身是另一种特殊语法形式的一部分时，这将无法正常工作后来变了）。我不认为只是将函数包装在另一个中。
@RainerJoswig 使用make-symbol 与gensym 相比有哪些优点/缺点？

【解决方案2】：

是

(let* ((a (lambda (f x) (funcall f (* x 2))))
       (b (function-generator)))
    (funcall a b 10))

一个相当干净的解决方案？

【讨论】：

显然，这与flet 不同，后者将给定的标识符绑定在函数命名空间中。 :-(
@ChrisJester-Young 不，它与flet 不同，但它是一个小的重写，使问题中的代码工作。因此，是否可以将其视为相当干净解决方案的问题。
您的解决方案实际上是我正在寻找的解决方案的宏观扩展。我不想到处写funcall——在宏定义中只写一次。

【解决方案3】：

如何将变量与let 绑定，使它们成为setfable，然后使用flet 作为let 的主体，使它们成为funcallable 和@987654327 @-able，也是。例如，我给出了一个愚蠢的小函数而不是(generate-function)：

(let ((a (lambda (f x)
           (funcall f (* x 2))))
      (b (lambda (&rest args)
           (print (list* 'print-from-b args)))))
  (flet ((a (&rest args)
           (apply a args))
         (b (&rest args)
           (apply b args)))
    (a #'b 10)))

我们可以相对容易地将其封装在一个宏中：

(defmacro let/flet (bindings &body body)
  (let ((args (gensym (string '#:args-))))
    `(let ,bindings
       (flet ,(loop :for (name nil) :in bindings
                 :collect `(,name (&rest ,args) (apply ,name ,args)))
         ,@body))))

现在

(let/flet ((a (lambda (f x)
                (funcall f (* x 2))))
           (b (lambda (&rest args)
                (print (list* 'print-from-b args)))))
  (a #'b 10))

扩展到第一个代码块。请注意，您也可以在正文中使用(a b 10)，因为b 的绑定与#'b 的值相同。您也可以在变量上使用setf：

(let/flet ((a (lambda (x)
                (print (list 'from-a x)))))
  (a 23)
  (setf a (lambda (x)
            (print (list 'from-new-a x x))))
  (a 23))

打印

(FROM-A 23) 
(FROM-NEW-A 23 23)

【讨论】：

这里的 let/flet 组合和6502's answer 中的一样（写这个之前我没有仔细阅读），只是这里保留了变量绑定，所以setf 对它们起作用，这是问题中的要求之一。我认为宏代码也更容易阅读。
这很好，但我认为 6502 的答案稍微好一些，因为他不会污染变量命名空间。还是不错的。
@nbtrap 这是否意味着您根本不需要setf 函数？
能够设置 本地函数槽 将使我能够编写一个我所设想的干净宏（不会弄乱变量命名空间）。但是您和 6502 提供的解决方案使这变得不必要了。我想得太浅了。
@nbtrap 啊，那么是的，6502 非常适合不污染变量命名空间。如果有人确实希望能够更新绑定，我将把它留在这里（而且，虽然这可能只是个人喜好，但我仍然认为这个宏代码（可以很容易地修改为污染值命名空间）更容易理解。

【解决方案4】：

如果有人对 labels 等价物感兴趣，这里是：

(defmacro my-labels ((&rest definitions) &rest body)
  (let ((gensyms (loop for d in definitions collect (gensym)))
        (names (loop for d in definitions collect (car d)))
        (fdefs (loop for f in definitions collect (cadr f)))
        (args (gensym)))
    `(let (,@(loop for g in gensyms collect (list g)))
       (labels (,@(loop for g in gensyms for n in names
                     collect `(,n (&rest ,args) (apply ,g ,args))))
         ,@(loop for g in gensyms for f in fdefs
                collect `(setf ,g ,f))
         ,@body))))

这有点像 Scheme 的 letrec。

【讨论】：