CLisp 23：运行时修改函数的实现

       运行时修改函数的实现，对LISP来说并不是稀奇事，用defun重新定义一个即可。这里介绍一个具体的、高级的做法，可以加深理解LISP函数的本质。例子很简单，只有几行代码，先定义一个函数foo，作用是乘方，然后再改掉foo的实现，新的实现仍然可以使用函数foo的原有实现。

       (defun foo (x) (* x x))                

       (let* ((oldf (symbol-function 'foo))            

               (newf #'(lambda (x)

                           (* x (funcall oldf x)))))

            (setf (symbol-function 'foo) newf))

       上面例子修改了函数foo的实现，也可以不修改foo的实现，让它完成本该完成的事情，同时做一些额外的事情，例如统计调用次数，或者统计执行时间，或者记录每次调用的输入参数，等等。

       LISP的Trace工具用的就这个原理，例如

[5]> (defun my-nth (n x)            先定义一个函数，取列表x中第n个元素

(cond ((zerop n) (first x))

(t (my-nth (- n 1) (rest x)))))

MY-NTH

 [7]> (dtrace my-nth)          声明要跟踪函数my-nth的调用情况，用的是dtrace版本

(MY-NTH)

[8]> (my-nth 2 '(a b c d e))  再执行my-nth时，会打印详细的调用过程

----Enter MY-NTH

|     Arg-1 = 2

|     Arg-2 = (A B C D E)

|   ----Enter MY-NTH

|   |     Arg-1 = 1

|   |     Arg-2 = (B C D E)

|   |   ----Enter MY-NTH

|   |   |     Arg-1 = 0

|   |   |     Arg-2 = (C D E)

|   |    \--MY-NTH returned C

|    \--MY-NTH returned C

 \--MY-NTH returned C

C                   这是最后的返回结果

 

DTrace的源代码很短，下面是主体部分，输入函数名，把该函数的实现替换掉

(defun trace-function (name)

  (let* ((formal-arglist (fetch-arglist name))       获取原函数的参数列表，形参

        (old-defn (symbol-function name))           取到原来的函数

        (new-defn                                              定义新的函数

         #'(lambda (&rest argument-list)

             (let ((result nil))

              (display-function-entry name)                    显示函数名称

              (let ((*trace-level* (1+ *trace-level*)))

                (with-dtrace-printer-settings

                 (show-function-args argument-list formal-arglist))       显示输入参数，实参

                (setf result (multiple-value-list

                            (apply old-defn argument-list))))  调用原函数

              (display-function-return name result)          显示执行结果

              (values-list result)))))                                返回执行结果

    (setf (get name 'original-definition) old-defn)      保存原函数实现，恢复时使用

    (setf (get name 'traced-definition) new-defn)             

    (setf (get name 'traced-type) 'defun)

(setf (symbol-function name) new-defn)))         用新函数替换原函数

注：在Common LISP中，可以用system::arglist获取函数的形参列表