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

21
collects/mzlib/trace.ss
View File

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