Macro stepper: eliminated (unneeded) synchronization from tracing

svn: r5544

original commit: c4c5d6cd13715cbef58ca03cb3bacf4af9e53526
This commit is contained in:
Ryan Culpepper 2007-02-02 19:56:03 +00:00
parent d4b7882999
commit c5ab275cee

View File

@ -38,27 +38,15 @@
;; expand+tracer : syntax/sexpr (syntax -> A) -> (values A/exn (-> event))
(define (expand+tracer sexpr expander)
(let* ([s (make-semaphore 1)]
[head (cons #f #f)]
[tail head]
(let* ([events null]
[pos 0])
(define (add! x)
(semaphore-wait s)
(set-car! tail x)
(set-cdr! tail (cons #f #f))
(set! tail (cdr tail))
(semaphore-post s))
(define get
(let ([head head])
(lambda ()
(semaphore-wait s)
(let ([result (car head)])
(set! head (cdr head))
(semaphore-post s)
result))))
(set! events (cons x events)))
(parameterize ((current-expand-observe
(let ([c 0])
(lambda (sig val)
(add! (cons sig val)))))
(set! c (add1 c))
(add! (cons sig val))))))
(let ([result
(with-handlers ([(lambda (exn) #t)
(lambda (exn)
@ -67,14 +55,17 @@
(expander sexpr))])
(add! (cons 'EOF pos))
(values result
(let ([events (reverse events)])
(lambda ()
(let* ([sig+val (get)]
[sig (car sig+val)]
(define sig+val (car events))
(set! events (cdr events))
(let* ([sig (car sig+val)]
[val (cdr sig+val)]
[t (tokenize sig val pos)])
(when (trace-verbose?)
(printf "~s: ~s~n" pos (token-name (position-token-token t))))
(printf "~s: ~s~n" pos
(token-name (position-token-token t))))
(set! pos (add1 pos))
t)))))))
t))))))))
)