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

forgot this rename in last commit

Browse Source 
svn: r16164

original commit: 6d2bdb9e1c82c9f10c4aba25b04d42a28a4a8d46
This commit is contained in:
Eli Barzilay 2009-09-29 13:40:17 +00:00
parent dedd29a452
commit 30648c15d5
1 changed files with 16 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/mzlib/trace.ss
View File

@ -179,7 +179,7 @@
;; the nesting depth:
(define -:trace-level-key (gensym))
(define trace-apply
(define trace-call
(make-keyword-procedure
(lambda (id f kws vals . args)
(do-traced id args kws vals f))
@ -195,9 +195,7 @@
-:trace-level-key)]
[level (if (null? levels) 0 (car levels))])
;; Tentatively push the new depth level:
(with-continuation-mark
-:trace-level-key
(add1 level)
(with-continuation-mark -:trace-level-key (add1 level)
;; Check for tail-call => car of levels replaced,
;; which means that the first two new marks are
;; not consecutive:
@ -212,9 +210,7 @@
;; call will.
(begin
(-:trace-print-args id args kws kw-vals (sub1 level))
(with-continuation-mark
-:trace-level-key
(car levels)
(with-continuation-mark -:trace-level-key (car levels)
(if (null? kws)
(apply real-value args)
(keyword-apply real-value kws kw-vals args))))
@ -224,22 +220,19 @@
;; tail-call detection the next time around):
(begin
(-:trace-print-args id args kws kw-vals level)
(with-continuation-mark
-:trace-level-key
level
(call-with-values (lambda ()
(with-continuation-mark
-:trace-level-key
(add1 level)
(if (null? kws)
(apply real-value args)
(keyword-apply real-value kws kw-vals args))))
(lambda results
(flush-output)
;; Print the results:
(-:trace-print-results id results level)
;; Return the results:
(apply values results))))))))))
(with-continuation-mark -:trace-level-key level
(call-with-values
(lambda ()
(with-continuation-mark -:trace-level-key (add1 level)
(if (null? kws)
(apply real-value args)
(keyword-apply real-value kws kw-vals args))))
(lambda results
(flush-output)
;; Print the results:
(-:trace-print-results id results level)
;; Return the results:
(apply values results))))))))))
(define-for-syntax (check-ids stx ids)
(for ([id (in-list (syntax->list ids))])