lisp - 修改函数；保存到 lisp 中的新函数

Question

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

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 可能不适用的函数的一般任务更感兴趣。我相信我可以用这种形式修改 body :

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

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

我的问题具体是如何

1. 创建一份 foo 到 newfoo 并用值替换正文 上面定义的newbody。 (我有 查看了 fset、setf 和 function 但可能没有使用 他们正确。)
2. 可能将它包装在一个函数中 称为 makenewfoo() 之类的 这样我就可以调用 makenewfoo(foo) 并允许它 创建 newfoo()。

而且，更一般地说，

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

Answer 1

它在 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 和 :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)))