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)))