suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added current-trace-results

Browse Source
This commit is contained in:
Robby Findler 2010-11-07 14:32:06 -06:00
parent 96018f258c
commit a63bbf82ab
2 changed files with 49 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
collects/racket/trace.rkt
View File

@ -4,7 +4,9 @@
(for-syntax scheme/base)) (for-syntax scheme/base))
(provide trace untrace (provide trace untrace
current-trace-print-args trace-call current-trace-print-results
current-trace-print-args
trace-call
current-trace-notify current-trace-notify
current-prefix-out current-prefix-in) current-prefix-out current-prefix-in)
@ -108,42 +110,43 @@
(lambda (name results level) (lambda (name results level)
(as-trace-notify (as-trace-notify
(lambda () (lambda ()
(trace-print-results name results level))))) ((current-trace-print-results) name results level)))))
(define trace-print-results (define current-trace-print-results
(lambda (name results level) (make-parameter
(let-values (((first rest) (lambda (name results level)
(build-prefixes level (current-prefix-out)))) (let-values (((first rest)
(parameterize ((pretty-print-print-line (build-prefixes level (current-prefix-out))))
(lambda (n port offset width) (parameterize ((pretty-print-print-line
(display (lambda (n port offset width)
(display
(if n
(if (zero? n) first (format "\n~a" rest))
"\n")
port)
(if n (if n
(if (zero? n) first (format "\n~a" rest)) (if (zero? n)
"\n") (string-length first)
port) (string-length rest))
(if n 0))))
(if (zero? n) (cond
(string-length first) ((null? results)
(string-length rest)) (pretty-display "*** no values ***"))
0)))) ((null? (cdr results))
(cond (pretty-print (car results)))
((null? results) (else
(pretty-display "*** no values ***")) (pretty-print (car results))
((null? (cdr results)) (parameterize ((pretty-print-print-line
(pretty-print (car results))) (lambda (n port offset width)
(else (display
(pretty-print (car results)) (if n
(parameterize ((pretty-print-print-line (if (zero? n) rest (format "\n~a" rest))
(lambda (n port offset width) "\n")
(display port)
(if n (if n
(if (zero? n) rest (format "\n~a" rest)) (string-length rest)
"\n") 0))))
port) (for-each pretty-print (cdr results))))))))))
(if n
(string-length rest)
0))))
(for-each pretty-print (cdr results)))))))))
;; A traced-proc struct instance acts like a procedure, ;; A traced-proc struct instance acts like a procedure,

12
collects/scribblings/reference/trace.scrbl
View File

@ -92,3 +92,15 @@ ordinary arguments, its keywords, the values of the keywords, and a
number indicating the depth of the call. number indicating the depth of the call.
} }
@defparam[current-trace-results trace-print-results
(-> symbol?
list?
number?
any)]{
The value of this parameter is invoked to print out the results of a
traced call. It receives the name of the function, the function's
results, and a number indicating the depth of the call.
}