[xyzzy:03704] trace

[masahito henmi <henmi@xxxxxxxxxxxxx>]

おはようございます。

へなちょこデバッグ支援作ってみたのですが、添削とかお願い
します＞亀井さん

&optionalとか&restとか&keyとか、たぶん今は動かないと思う
のですが、動かすにはどうすればいいか、ヒントとかいただけると
うれしいです。

;; 使い方
;; (defun foo (a b)  (+ a b))  の時
;; (trace 'foo)
(defun trace (func)
  (if (and (fboundp func) (null (get func 'old-func)))
      (let* ((def (symbol-function func))
	     (args (cadr (si:closure-body def)))
	     newfunc)
	(setf (get func 'old-func) def)
	(setq newfunc
	    (if (commandp func)
		  `(lambda ,args
		     ,(caddr (si:closure-body def)) ; interactive
		     (trace-message "Enter: ~s ~s\n" ',func ,args)
		     (let ((ret (funcall (get ',func 'old-func) ,@args)))
		       (trace-message "Exit: ~s ~s\n" ',func ret)
		       ret
		     ))
		`(lambda ,args
		   (trace-message "Enter: ~s ~s\n" ',func ,args)
		   (let ((ret (funcall (get ',func 'old-func) ,@args)))
		     (trace-message "Exit: ~s ~s\n" ',func ret)
		     ret
		   ))
	    ))
	(trace-message "new = ~s\n" newfunc)
	(setf (symbol-function func) newfunc)
      )
    (message "can't trace")))

(defun trace-message (fmt &rest args)
  (apply #'format
	 (cons *error-output* (cons fmt args))))

(defun untrace* (func)
  (setf (get func 'old-func) nil))

(defun untrace (func)
  (if (get func 'old-func)
      (setf (symbol-function func) (get func 'old-func))
    (message "can't untrace")))
------------------------------------------------------------
逸見雅人    Masahito Henmi  henmi@xxxxxxxxxxxxx
♪あなたの願いも仕事もうまくいきますように・・・