49 lines
1.3 KiB
Scheme
49 lines
1.3 KiB
Scheme
|
;;; -*-Scheme-*-
|
||
|
|
;;;
|
||
|
|
;;; A simple trace package contributed in 1990 by WAKITA Ken
|
||
|
|
;;; (ken-w@is.s.u-tokyo.ac.jp)
|
||
|
|
|
||
|
|
(define trc:trace-list '(()))
|
||
|
|
|
||
|
|
(define (reset-trace) (set! trc:trace-list '(())))
|
||
|
|
|
||
|
|
(define-macro (trace func)
|
||
|
|
`(let ((the-func (eval ,func))
|
||
|
|
(result #v))
|
||
|
|
(if (assoc ',func trc:trace-list)
|
||
|
|
(error 'trace "~s already trace on." ,func))
|
||
|
|
(if (not (compound? ,func))
|
||
|
|
(error 'trace "wrong argument type ~s (expected compound)"
|
||
|
|
(type ,func)))
|
||
|
|
(set! trc:trace-list
|
||
|
|
(cons '()
|
||
|
|
(cons (cons ',func the-func)
|
||
|
|
(cdr trc:trace-list))))
|
||
|
|
(set! ,func
|
||
|
|
(lambda param-list
|
||
|
|
(format #t "# Entering ~s~%"
|
||
|
|
(cons ',func param-list))
|
||
|
|
(set! result (apply the-func param-list))
|
||
|
|
(format #t "# Exiting ~s ==> ~s~%"
|
||
|
|
(cons ',func param-list)
|
||
|
|
result)
|
||
|
|
result))))
|
||
|
|
|
||
|
|
(define-macro (untrace func)
|
||
|
|
`(let ((the-func (assoc ',func trc:trace-list)))
|
||
|
|
|
||
|
|
(define (remove! func)
|
||
|
|
(let ((prev trc:trace-list)
|
||
|
|
(here (cdr trc:trace-list)))
|
||
|
|
(while (and here
|
||
|
|
(not (eq? func (caar here))))
|
||
|
|
(set! prev here)
|
||
|
|
(set! here (cdr here)))
|
||
|
|
(if (not here)
|
||
|
|
(error 'remove "item ~s not found." func)
|
||
|
|
(set-cdr! prev (cdr here)))))
|
||
|
|
|
||
|
|
(if the-func
|
||
|
|
(begin (remove! ',func)
|
||
|
|
(set! ,func (cdr the-func))))))
|