diff options
Diffstat (limited to 'trace.scm')
| -rw-r--r-- | trace.scm | 24 |
1 files changed, 13 insertions, 11 deletions
@@ -1,5 +1,5 @@ -;;;; "trace.scm" Utility macros for tracing in Scheme. -;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2000 Aubrey Jaffer +;;;; "trace.scm" Utility functions and macros for tracing in Scheme. +;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2000, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -18,8 +18,11 @@ ;each case. (require 'qp) ;for the qp printer. +(require 'alist) + (define trace:indent 0) (define debug:call-stack '()) ;keeps track of call stack. +;@ (define debug:max-count 5) ;;Formats for call-stack elements: @@ -27,6 +30,7 @@ ;; (procedure-count name) ;for debug:stack procedure ;;Traced functions also stack. +;@ (define print-call-stack (let ((car car) (null? null?) (current-error-port current-error-port) (qpn qpn) (for-each for-each)) @@ -121,7 +125,7 @@ ;;; The reason I use a symbol for debug:untrace-object is so that ;;; functions can still be untraced if this file is read in twice. - +;@ (define (untracef function) (set! trace:indent 0) (function 'debug:untrace-object)) @@ -130,7 +134,6 @@ ;;; niceties like keeping track of traced functions and dealing with ;;; redefinition. -(require 'alist) (define trace:adder (alist-associator eq?)) (define trace:deler (alist-remover eq?)) @@ -190,13 +193,14 @@ (set! *stacked-procedures* (trace:deler *stacked-procedures* sym)) (finish p))) (else fun))) - +;@ (define (tracef . args) (apply debug:trace-procedure 'trace args)) +;@ (define (trackf . args) (apply debug:trace-procedure 'track args)) +;@ (define (stackf . args) (apply debug:trace-procedure 'stack args)) - ;;;; Finally, the macros trace and untrace - +;@ (defmacro trace xs (if (null? xs) `(begin (set! trace:indent 0) @@ -222,7 +226,7 @@ (map car *stacked-procedures*)) `(begin ,@(map (lambda (x) `(set! ,x (trace:trace-procedure 'stack ,x ',x))) xs)))) - +;@ (defmacro untrace xs (if (null? xs) (slib:eval @@ -232,7 +236,6 @@ '',(map car *traced-procedures*))) `(begin ,@(map (lambda (x) `(set! ,x (trace:untrace-procedure ,x ',x))) xs)))) - (defmacro untrack xs (if (null? xs) (slib:eval @@ -242,7 +245,6 @@ '',(map car *tracked-procedures*))) `(begin ,@(map (lambda (x) `(set! ,x (track:untrack-procedure ,x ',x))) xs)))) - (defmacro unstack xs (if (null? xs) (slib:eval |