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

.

Browse Source 
original commit: 1cc989913568e322b23ce1dd4e1768448ff22b33
This commit is contained in:
Matthew Flatt 2001-11-09 22:19:14 +00:00
parent 2d7eb8b13b
commit 3c97427396
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mzlib/trace.ss
View File

@ -179,14 +179,14 @@
(error 'trace (error 'trace
"~s is not bound" 'id) "~s is not bound" 'id)
(raise exn))))) (raise exn)))))
(let ((global (global-defined-value 'id))) (let ((global (namespace-variable-binding 'id)))
(unless (procedure? global) (unless (procedure? global)
(error 'trace (error 'trace
"the top-level value of ~s is not a procedure" 'id)))) "the top-level value of ~s is not a procedure" 'id))))
... ...
(let ((global-value (global-defined-value 'id))) (let ((global-value (namespace-variable-binding 'id)))
(let ((table-entry (hash-table-get -:trace-table 'id (lambda () #f)))) (let ((table-entry (hash-table-get -:trace-table 'id (lambda () #f))))
(unless (and table-entry (unless (and table-entry
(eq? global-value (eq? global-value
@ -212,7 +212,7 @@
(sub1 (-:trace-level)))))))) (sub1 (-:trace-level))))))))
(hash-table-put! -:trace-table 'id (hash-table-put! -:trace-table 'id
(-:make-traced-entry real-value traced-name)) (-:make-traced-entry real-value traced-name))
(global-defined-value 'id traced-name))))) (namespace-variable-binding 'id traced-name)))))
... ...
'(id ...)))))]))) '(id ...)))))])))
@ -235,11 +235,11 @@
(let ((entry (hash-table-get -:trace-table (let ((entry (hash-table-get -:trace-table
'id (lambda () #f)))) 'id (lambda () #f))))
(if (and entry (if (and entry
(eq? (global-defined-value 'id) (eq? (namespace-variable-binding 'id)
(-:traced-entry-trace-proc entry))) (-:traced-entry-trace-proc entry)))
(begin (begin
(hash-table-put! -:trace-table 'id #f) (hash-table-put! -:trace-table 'id #f)
(global-defined-value 'id (-:traced-entry-original-proc entry)) (namespace-variable-binding 'id (-:traced-entry-original-proc entry))
(list 'id)) (list 'id))
'())) '()))
...))))]))) ...))))])))