修改函数；在lisp中保存到新函数

Question

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

emacs中的玩具示例(可能不是最理想的，因为它是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到newfoo的副本，并将主体替换为上面定义的newbody值。(我已经研究过properly.)
2. possibly、setf和function，但可能没有使用它们，但可能没有使用它们，而是将它们包装在一个名为makenewfoo()或类似的函数中，这样我就可以调用makenewfoo(foo)并允许它创建newfoo().

)。

而且，更广泛地说，

functions?

• this通常是这样的，或者有一种更惯用的方法来修改是一个非常简单的例子，但是是否有一种比将列表元素编号指定给nth进行修改更普遍的方法呢？例如，实际的函数更复杂，因此是否有一种方法可以递归地搜索这个s-表达式树并测试特定语法，并在它之前或之后插入这个conditional-transformation表达式(可能使用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)))