修改功能;在lisp中保存爲新函數

Question

所以我認爲lisp（在其他語言中）的優點之一是它能夠實現函數工廠（接受函數作爲參數;返回新函數）。我想使用這個功能對函數進行小的修改並將其保存爲一個新函數，以便如果對原函數進行更改，它們也會反映在它所基於的新函數中。注意：我不是編寫原始函數的人，所以我不一定要將通用部分封裝在一個單獨的函數中，以便兩者都調用，否則這將是明顯的答案。在emacs中

玩具例如口齒不清（可能不是最理想的，因爲它是一個口齒不清-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 值更換閥體。 （我 看着fset，setf和 function但也許沒有使用 他們正確。）
2. 可能把這個包在一個名爲makenewfoo()什麼 這樣的功能 這樣我就可以調用 makenewfoo(foo)，並允許這 創建newfoo()。

而且，更爲普遍，

1. 是一樣的東西，這是常見的 做或有修改功能的更地道 方式？
2. 這是一個非常簡單的情況，但是 還有一個比 指定列表元素編號 更改爲nth的更一般方式。對於 例如，實際功能是 更復雜，所以是有辦法 遞歸搜索下來了 特定的語法，這 s表達式樹和測試之前或 （可能使用equal後插入此 conditional-transformation 表達），所以對 的原始功能做出的更改不敏感嗎？

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