Macro stepper: eliminated (unneeded) synchronization from tracing
svn: r5544 original commit: c4c5d6cd13715cbef58ca03cb3bacf4af9e53526
This commit is contained in:
parent
d4b7882999
commit
c5ab275cee
|
@ -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
|
||||
(lambda (sig val)
|
||||
(add! (cons sig val)))))
|
||||
(let ([c 0])
|
||||
(lambda (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
|
||||
(lambda ()
|
||||
(let* ([sig+val (get)]
|
||||
[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))))
|
||||
(set! pos (add1 pos))
|
||||
t)))))))
|
||||
(let ([events (reverse events)])
|
||||
(lambda ()
|
||||
(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))))
|
||||
(set! pos (add1 pos))
|
||||
t))))))))
|
||||
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue
Block a user