使用 defun 以编程方式构造 Common Lisp 函数

Question

我想使用defun 定义一个函数，但不是在顶层。 （函数名称和主体需要根据一些用户输入来构造。）下面说明了基本目标：

(let ((name 'fn1)
      (body "abc"))
  (eval `(defun ,name ()
           ,body))
  (push name *function-names*))

1) 这行得通，但没有eval 怎么办？

2) 目前，我正在编译一些这样的函数

(loop for fn-name in *function-names* do
      (setf (symbol-function fn-name)
        (compile nil (symbol-function fn-name))))

但是当函数体包含对函数的递归调用时，是否有更好的方法只使用 fn 名称，例如 `(compile ,fn-name) 来避免 SBCL 编译器警告？

Answer 1

在没有DEFUN 的情况下这样做会有点问题。我认为这是 ANSI Common Lisp 的一部分，它不是很好。

如果您查看 Common Lisp 的实现，它们会将 DEFUN 表单扩展为特定于实现的构造。我们经常会看到类似命名的 lambda。

SBCL：

(defun foo ()
  (foo))

->

(SB-INT:NAMED-LAMBDA FOO ()
  (BLOCK FOO (FOO)))

计算结果为：

#<FUNCTION FOO {1003271FFB}>

不幸的是，命名为 lambda 在 ANSI CL 中不是一个概念。

要做到这一点，您需要：

• 构造 DEFUN 表单
• 评估它
• 可选择编译它

为了获得类似的效果，我们可以创建一个文件，编译并加载它。

或者，我们可以尝试不使用 DEFUN。

• 我们需要确保全局名称不是宏
• 然后我们构造一个 lambda 表达式
• 然后我们编译那个表达式

示例：递归函数：

(compile 'my-fn '(lambda () (my-fn))

现在我们可能仍然会在编译 lambda 时收到关于未定义函数的警告。我们如何提供名称？ LABELS 会这样做：

(compile 'my-fn
         (lambda ()
           (labels ((my-fn ()
                      (my-fn)))
             (my-fn))))

LABELS 也会设置 BLOCK，如 DEFUN。

当我们现在调用全局 MY-FN 时，它会调用本地 MY-FN，然后它可以递归调用自身。

让我们看看是否有更多替代方法...

• 也可以使用带有 COMPILE 的普通 LAMBDA 并首先声明函数。这也可能会抑制编译警告。

Answer 2

我对“为什么”您尝试使用 defun 执行此操作有点困惑，但是如果您希望用户能够定义他们自己的功能，然后调用 他们，有几种方法可以做到这一点。

1) 如果您像普通的 defun 函数一样对其进行评估，那么您可以执行类似的操作

(loop for f in *my-functions-names* and
      for a in *my-functions-args* and
      for b in *my-functions-bodies*
  do (setf (symbol-function f) (compile `(lambda ,a ,b))))

然后用户可以在执行时编译他们的函数，并且看起来它一直都在那里。

2) 创建一个包含 lambda 和 funcall（或 apply）函数的哈希表：

(defparameter *user-functions* (make-hash-table))

(defun def-user-fun (f-name f-args f-body &optional (ns *user-functions*))
  (setf (gethash f-name ns) (compile nil `(lambda ,f-args ,f-body))))

(defun call-user-fun (f-name args &optional (ns *user-functions*))
  (funcall (gethash f-name *user-funcations) f-args))

这将允许用户定义他们想要在当前环境中评估的函数。

3) 如果这只是为了节省您编译自己的代码的时间，那么您可以做您所做的，但使用 defmacro 和循环语句。

更新

由于您需要递归，因此您可以执行类似于@rainerjoswig 对(lambda (args..) (labels ((recurse ...)) (recurse ...))) 建议的操作。尽管以命令式的方式看起来可能并不“好”，但这在 Lisp 中是惯用的。事实上，SBCL compiler 和 garbage collector 都专门针对这种递归进行了调整。如果您想了解可以依赖的 Common Lisp 优化，您应该阅读standard。

是(compile 'fname) == (setf (symbol-function 'fname) (compile nil (symbol-function 'fname)))？ 是和否。至少可能不是你想的那样。在我看来，您对两件事感到困惑，这两件事都是 lisp“后端”的神秘机器的一部分。

首先，symbol-function 不是一个 求值器，它只是让 lisp 读者知道 this 符号是一个 function 符号并且应该通过 function 环境而不是当前的词法环境来访问，也就是说，函数像变量一样被访问，但在不同的环境或命名空间中。我敢打赌，labels 在后台是如何扩展的就是这个功能。

其次，compile 也不能那样工作。您可以传递给它一个 symbol-function 名称，它访问 存储的 函数定义，编译它，然后是带有编译定义的旧定义 (compile 'my-func)，您可以传递一个 lambda它将编译的表达式，(compile nil (lambda (args...) body))，或者，最后，您可以同时传递名称和定义，将编译后的函数存储为该函数变量。

所以是的，从某种意义上说，它确实会扩展到 setf，但不会扩展到您的特定 setf，因为您不应该这样做 (compile nil (symbol-function 'fname))。

至于允许递归，通过解构一般defun 形式的形式来扩展@rainerjoswig 很简单

(def-user-func count-down (val) 
  (if (> val 0)
    (progn (print val) (count-down (1- val)))
    nil))

使用类似宏

(defmacro def-user-func (name args &body body)
  `(compile ',name (lambda (,@args)
                     (labels ((,name (,@args)
                                ,@body))
                        (,name ,@args)))))

由于 lisp 在 let、labels 和其他类似语句中隐藏变量名称的方式，这将非常有效。 “外部”世界只看到一个函数，而该函数只看到它自己的labels 函数。当,@body 扩展时，它会在labels 的上下文中这样做，并且由于我们重复了名称，它会正常工作。