Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!mips!spool.mu.edu!snorkelwacker.mit.edu!ai-lab!zurich.ai.mit.edu!jaffer
From: jaffer@zurich.ai.mit.edu (Aubrey Jaffer)
Newsgroups: comp.lang.scheme
Subject: function tracing in Scheme
Message-ID: <JAFFER.91Apr26120238@kleph.ai.mit.edu>
Date: 26 Apr 91 16:02:38 GMT
Sender: news@ai.mit.edu
Distribution: comp.lang.scheme
Organization: M.I.T. Artificial Intelligence Lab.
Lines: 58

Here is code for tracing functions which should work in any scheme.
If you have macros on you system you can add some syntactic sugar and
finish the job.  And yes, it can trace itself.  And no, it doesn't get
screwed up if you trace functions it uses.

;;;; Utility functions for debugging in Scheme.

;;; TRACEF REALLY NEEDS A `PRINT ANYTHING ON ONE LINE' ROUTINE.  DOES
;;; SOMEONE CARE TO WRITE IT?

;;; to TRACE type
;;; (set! <symbol> (tracef <symbol>)) or
;;; (set! <symbol> (tracef <symbol> '<symbol>)) or
;;; (define <symbol> (tracef <function>)) or
;;; (define <symbol> (tracef <function> '<symbol>))

;;; to UNTRACE type
;;; (set! <symbol> (untracef <symbol>))

(define tracef
  (let ((null? null?)			;These bindings are so that
	(not not)			;tracef will not trace parts
	(car car)			;of itself.
	(cdr cdr)
	(eq? eq?)
	(write write)
	(display display)
	(newline newline)
	(apply apply)
	(for-each for-each))
    (lambda (function . optname)
      (let ((name (if (null? optname) function (car optname))))
	(lambda args
	  (cond ((and (not (null? args))
		      (eq? (car args) '**special-untrace-object**)
		      (null? (cdr args)))
		 function)
		(else
		 (display "CALL [")
		 (write name)
		 (display #\ )
		 (for-each (lambda (x) (write x) (display #\ )) args)
		 (display "]")
		 (newline)
		 (let ((ans (apply function args)))
		   (display "RETURNED [")
		   (write name)
		   (display " ==> " )
		   (write ans)
		   (display "]")
		   (newline)
		   ans))))))))

;;; the reason I use a symbol for **special-untrace-object** is so
;;; that functions can still be untraced if this file is read in twice.

(define (untracef function)
  (function '**special-untrace-object**))