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的实现会产生一些有趣的结果。

罗伯特史密斯的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

当然，这与申请有同样的问题，并且注释包括

不幸的是，宏不是一个非常有效的实现。那里是函数调用的间接级别。基本上，一个带有绑定的LETREC
(name fn)
扩展为表单
的LABELS绑定
(name (&rest args)
  (apply fn args))
这有些糟糕。

欢迎使用补丁来实现特定于实现的方法   宏。

2005年，user rhat asked on comp.lang.lisp关于Common Lisp等同于Scheme的letrec，并指向标签。

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等功能。

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

P.S。实际上(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

词法设置功能符号

2 个答案:

替代