词法设置函数符号

Question

我正在寻找一种方法来轻松、暂时地交换功能。 我知道我可以像这样手动设置函数符号：

CL-USER> (setf (symbol-function 'abcd) #'+)
#<FUNCTION +>
CL-USER> (abcd 1 2 4)
7

我也知道labels 或flet 可以临时为就地定义的函数设置名称：

CL-USER> (labels ((abcd (&rest x) 
                    (apply #'* x)))
            (abcd 1 2 4))
8

有没有办法手动、词法地设置函数名？例如：

CL-USER> (some-variant-of-labels-or-let ((abcd #'*))
            (abcd 1 2 4))
8

注意：我尝试深入了解标签和 flet 的来源，但两者都是特殊运算符。不开心。

Answer 1

您可以使用symbol-function 修改的绑定不是词法绑定，因此这种选项实际上并不适用。建立词法绑定函数的唯一方法是通过标签和 flet，因此您必须使用它们。也就是说，您可以使用宏轻松获得所需的语法：

(defmacro bind-functions (binder bindings body)
  `(,binder ,(mapcar (lambda (binding)
                       (destructuring-bind (name function) binding
                         `(,name (&rest #1=#:args)
                                 (apply ,function #1#))))
                     bindings)
            ,@body))

(defmacro fflet ((&rest bindings) &body body)
  `(bind-functions flet ,bindings ,body))

(defmacro flabels ((&rest bindings) &body body)
  `(bind-functions labels ,bindings ,body))

fflet 和 flabels 都采用函数指示符（符号或函数）并使用它们和任何附加参数调用 apply。因此您可以使用#'* 或'+。

(fflet ((product #'*)
        (sum '+))
  (list (product 2 4)
        (sum 3 4)))
;=> (8 7)

这确实意味着您引入了apply 的开销，但尚不清楚您可以采取哪些措施来避免它。由于 lambda 表达式可以引用绑定的名称，我们可以允许这些引用指向新绑定的函数，或者指向外部的任何内容。这也是 flet 和标签之间的区别，这也是基于每个实现版本的原因：

(fflet ((double (lambda (x)
                  (format t "~&outer ~a" x)
                  (list x x))))
  (fflet ((double (lambda (x)
                    (format t "~&inner ~a" x)
                    (double x))))                           ; not recursive
    (double 2)))
; inner 2
; outer 2
;=> 2 2

(flabels ((factorial (lambda (n &optional (acc 1))
                       (if (zerop n) acc
                           (factorial (1- n) (* acc n)))))) ; recursive
  (factorial 7))
;=> 5040  

---

替代方案

在考虑了一段时间后，我突然想到，在 Scheme 中，fflet 与 let 相同，因为 Scheme 是 Lisp-1。要获得flabels 的行为，您必须在Scheme 中使用letrec。为 Common Lisp 搜索 letrec 的实现会发现一些有趣的结果。

Robert Smith 的Letrec for Common Lisp 包含以下描述和示例：

LETREC:LETREC 是一个宏，旨在模仿Scheme 的letrec 形式。 它是 Common Lisp 中函数式编程的有用构造， 您有需要在功能上产生功能的表格 绑定到一个符号。

  (defun multiplier (n)
    (lambda (x) (* n x)))

  (letrec ((double (multiplier 2))
           (triple (multiplier 3)))
    (double (triple 5)))
  ;= 30

当然，这与 apply 有相同的问题，并且注释包括

不幸的是，宏不是一个非常有效的实现。那里 是函数调用的间接级别。本质上，一个 LETREC 与绑定

(name fn)

扩展为表单的 LABELS 绑定

(name (&rest args)
  (apply fn args))

这有点糟糕。

对于特定于实现的实现方式，欢迎使用补丁 宏。

在 2005 年，user rhat asked on comp.lang.lisp 关于一个相当于 Scheme 的 letrec 的 Common Lisp，并被指向标签。

Answer 2

您可以使用symbol-function 为全局定义的函数设置同义名称：

CL-USER> (setf (symbol-function 'factorial) #'!)
#<SYSTEM-FUNCTION !>
CL-USER> (factorial 5)
120

这样做的问题是您可以永久地全局获取它。但是您可以使用fmakunbound 删除定义：

CL-USER> (fmakunbound 'factorial)
FACTORIAL
CL-USER> (factorial 5) ; now here is no such function
; Evaluation aborted on #<SYSTEM::SIMPLE-UNDEFINED-FUNCTION #x19F36199>.
CL-USER> (! 5) ; still works
120

我想根据上述功能提出这个宏：

(defmacro with-synonyms (params &body body)
  `(prog2 (setf ,@(mapcan (lambda (x)
                            `((symbol-function ',(car x)) #',(cadr x)))
                          params))
     (progn ,@body)
     ,@(mapcar (lambda (x) `(fmakunbound ',(car x)))
               params)))

随心所欲：

CL-USER> (with-synonyms ((product *) (sum +))
           (product 2 (sum 2 3)))
10

宏展开：

(PROG2 (SETF (SYMBOL-FUNCTION 'PRODUCT) #'*
             (SYMBOL-FUNCTION 'SUM)     #'+)
  (PROGN (PRODUCT 2 (SUM 2 3)))
  (FMAKUNBOUND 'PRODUCT)
  (FMAKUNBOUND 'SUM))

在宏体之外没有product或sum这样的函数。

注意：这些同义函数仍然是全局定义的（虽然时间很短），所以这个解决方案并不理想。

---

附：其实(setf symbol-function)是非常非常邪恶的东西。

CL-USER> (setf (symbol-function 'normal-plus) #'+)
#<SYSTEM-FUNCTION +>
CL-USER> (defun magic-plus (&rest rest)
           (if (every (lambda (x) (= 2 x)) rest)
               5
               (apply 'normal-plus rest)))
MAGIC-PLUS
CL-USER> (setf (symbol-function '+) #'magic-plus)
#<FUNCTION MAGIC-PLUS (&REST REST) (DECLARE (SYSTEM::IN-DEFUN MAGIC-PLUS))
  (BLOCK MAGIC-PLUS (IF (EVERY (LAMBDA (X) (= 2 X)) REST) 5
(APPLY 'NORMAL-PLUS REST)))>
CL-USER> (+ 2 3)
5
CL-USER> (+ 5 5)
10
CL-USER> (+ 2 2)
5