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

typo in DFlag

Browse Source 
svn: r16179

original commit: 38388b1d346ce16c33afe65e44ee7bbb3315b67a
This commit is contained in:
Eli Barzilay 2009-09-30 03:55:22 +00:00
parent 8e8e3aa99f
commit dae17a2c21
1 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/mzlib/trace.ss
View File

@ -151,29 +151,28 @@
;; A traced-proc struct instance acts like a procedure, ;; A traced-proc struct instance acts like a procedure,
;; but preserves the original, too. ;; but preserves the original, too.
(define-values (struct:traced-proc make-traced-proc traced-proc? traced-proc-ref traced-proc-set!) (define-values (struct:traced-proc make-traced-proc traced-proc?
traced-proc-ref traced-proc-set!)
(make-struct-type 'traced-proc #f 2 0 #f null (current-inspector) 0)) (make-struct-type 'traced-proc #f 2 0 #f null (current-inspector) 0))
(define-struct traced-proc (proc orig)
)
;; Install traced versions of a given set of procedures. The traced ;; Install traced versions of a given set of procedures. The traced
;; versions are also given, so that they can be constructed to have ;; versions are also given, so that they can be constructed to have
;; a nice name. ;; a nice name.
(define (do-trace ids procs setters traced-procs) (define (set-traced! ids procs setters traced-procs)
(for-each (lambda (id proc) (for ([id (in-list ids)] [proc (in-list procs)])
(unless (procedure? proc) (unless (procedure? proc)
(error 'trace (error 'trace "the value of ~s is not a procedure: ~e" id proc)))
"the value of ~s is not a procedure: ~e" id proc))) (for ([proc (in-list procs)]
ids procs) [setter (in-list setters)]
(for-each (lambda (proc setter traced-proc) [traced-proc (in-list traced-procs)])
(unless (traced-proc? proc) (unless (traced-proc? proc)
(setter (make-traced-proc (setter (make-traced-proc
(let-values ([(a) (procedure-arity proc)] (let-values ([(a) (procedure-arity proc)]
[(req allowed) (procedure-keywords proc)]) [(req allowed) (procedure-keywords proc)])
(procedure-reduce-keyword-arity traced-proc (procedure-reduce-keyword-arity traced-proc a req allowed))
a proc)))))
req
allowed))
proc))))
procs setters traced-procs))
;; Key used for a continuation mark to indicate ;; Key used for a continuation mark to indicate
;; the nesting depth: ;; the nesting depth:
@ -247,7 +246,7 @@
(for/list ([id (in-list (syntax->list #'(id ...)))]) (for/list ([id (in-list (syntax->list #'(id ...)))])
(let ([tid (format "traced-~a" (syntax-e id))]) (let ([tid (format "traced-~a" (syntax-e id))])
(datum->syntax id (string->symbol tid) #f)))]) (datum->syntax id (string->symbol tid) #f)))])
#'(do-trace #'(set-traced!
'(id ...) '(id ...)
(list id ...) (list id ...)
(list (lambda (v) (set! id v)) ...) (list (lambda (v) (set! id v)) ...)