

(define *traced-functions* '())

(define trace (make-syntax (lambda names
(if (null? names)
'(map car *traced-functions*)
(let ((name (car names)))
`(begin
(set! *traced-functions*
(cons (cons ',name ,name) *traced-functions*))
(set! ,name
(let ((old-fn ,name))
(lambda args
(display "Entering: ")
(write (cons ',name args))
(newline)
(let ((result (apply old-fn args)))
(display "Exiting ")
(write ',name)
(display " => ")
(write result)
(newline)
result))))
(trace ,@(cdr names))))))))

(define untrace (make-syntax (lambda args
(let ((names (or args (map car *traced-functions*))))
`(begin
,@(map
(lambda (name)
`(set! ,name
(cdr (assq ',name *traced-functions*))))
names)
(set! *traced-functions*
,(if (null? args)
`'()
`(remove-if
(lambda (entry) (memq (car entry) ',names))
*traced-functions*))))))))
   X  
;;; Trace.scheme
Copyright Ó 1989, 1991 by Xerox Corporation.  All rights reserved.
;;; Last changed by Pavel on March 22, 1989 6:18:58 pm PST
;;; Michael Plass, January 20, 1989 10:13:55 pm PST
;;; (TRACE <name>*) -- Enables tracing on the functions with the given names
;;;	in the top-level environment.  Returns a list of all currently-traced
;;;	functions.
;;; (UNTRACE <name>+) -- Restores the named functions to their original,
;;;	untraced state.
;;; (UNTRACE) -- Restores all currently-traced functions to their original,
;;;	untraced state.
;;;
;;; It is an error to
;;;   1) Use TRACE or UNTRACE at anything other than top level.
;;;   2) Use TRACE on an undefined function, a non-function,
;;;	 or an already-TRACE'd function.
;;;   3) Redefine a TRACE'd function without first UNTRACE'ing it.
This is an a-list of names and procedures.
 Ê ä  –(cedarcode) style•NewlineDelimiter
™ default™Icodešœ
Ïeœ7™BK™:K™3—K˜ K™áK˜ ˜K™*—K˜ ˜(˜K˜˜˜˜K˜.—˜˜˜K˜;˜#K˜CK˜————K˜————K˜ ˜)˜5˜˜˜˜K˜(——K˜—˜˜K˜˜K˜+K˜——————— …—    *  f  