修改功能；保存到 Lisp 中的新函数

所以我认为 lisp（在其他语言中）的优点之一是它能够实现函数工厂（接受函数作为参数；返回新函数）。我想使用此功能对函数进行小的更改并将其保存为新函数，这样如果对原始函数进行更改，它们也会反映在它所基于的新函数中。注意：我不是编写原始函数的人，因此我不一定将公共部分封装在一个单独的函数中以供两者调用，否则这将是显而易见的答案。

emacs lisp 中的玩具示例（可能不是最理想的，因为它是 lisp-2）：

我有一个功能，foo提供给我的是：

(defun foo (x y)
    (+ x y)))

我希望我的新函数包含一条语句，允许我在满足特定条件时更改变量的值。例如：

(defun newfoo (x y)
  (if (condition-met-p x) 
      (setq x (transform x)))
    (+ x y))

请忽略我可以使用defadvice在这个特定的示例中，因为我对修改函数的一般任务更感兴趣，其中defadvice可能不适用。我相信我可以用这种形式修改身体：

(setq conditional-transformation 
      '(if (condition-met x) (setq x (transform x))))

(setq newbody (append conditional-transformation 
              (nth 2 (symbol-function 'foo)))))

我的问题具体是如何

1. 创建一个副本foo to newfoo并将正文替换为值 的newbody上面定义的。 （我有 调查了fset, setf, and function但也许不使用 他们正确地。）
2. 可能将其包装在一个函数中 被称为makenewfoo()或者其他的东西 像这样我可以调用makenewfoo(foo)并允许这 创造newfoo().

而且，更一般地说，

1. 像这样的事情很常见 完成或者有更惯用的 修改函数的方法？
2. 这是一个非常简单的案例，但是 有一个比更通用的方法 指定列表元素编号 到nth进行修改。为了 例如，实际函数是 更复杂，所以有没有办法 递归地搜索这个 s-表达式树并测试 特定语法并插入此conditional-transformation之前或之后的表达式 （可能使用equal），所以是这样 对所做的更改不太敏感 原来的功能？

它在 Emacs Lisp 中确实有效：

elisp> (defun foo (x y)
         (+ x y))
foo
elisp> (fset 'newfoo
             (append (lambda (x y)
                       (when (< x 2)
                         (setq x (* x 2))))
                     (cddr (symbol-function 'foo))))
(lambda
  (x y)
  (when
      (< x 2)
    (setq x
          (* x 2)))
  (+ x y))

elisp> (newfoo 1 3)
5
elisp> (newfoo 3 3)
6

但我真的不认为这是常见的做法或惯用的做法。你应该使用defadvice如果你想修改函数的行为。

就 CL 而言：一些实现提供类似的函数/宏（例如在 CCL 中：ccl:advise），并且您可以指定:before, :after, and :around泛型函数的方法。

插入表达式的示例代码：

(defun find-node (elt tree)
  (cond ((null tree) nil)
        ((equal (car tree) elt) tree)
        ((consp (car tree)) (let ((node (find-node elt (car tree))))
                              (if node node (find-node elt (cdr tree)))))
        (t (find-node elt (cdr tree)))))

(defun insert-before (node elt)
  (setcdr node (cons (car node) (cdr node)))
  (setcar node elt))

(let* ((function (copy-tree (symbol-function 'foo)))
       (node (find-node '(+ x y) function)))
  (when node
    (insert-before node '(if (< x 2) (setq x (* x 2))))
    (fset 'newfoo function)))