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

macro stepper: small reorg.

Browse Source 
svn: r12693
This commit is contained in:
Ryan Culpepper 2008-12-03 22:24:13 +00:00
parent 97fafb6ce4
commit ac293ce4c7
1 changed files with 36 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/macro-debugger/tool.ss
View File

@ -201,36 +201,44 @@
(define/private (make-stepper filename) (define/private (make-stepper filename)
(new drscheme-macro-stepper-director% (filename filename))) (new drscheme-macro-stepper-director% (filename filename)))
(define/private (inner-eval original-eval-handler e-expr)
(original-eval-handler e-expr))
(define/private (make-handlers original-eval-handler (define/private (make-handlers original-eval-handler
original-module-name-resolver) original-module-name-resolver)
(let* ([filename (send (send (get-top-level-window) (define filename (send (send (get-top-level-window) get-definitions-text)
get-definitions-text) get-filename/untitled-name))
get-filename/untitled-name)] (define director (make-stepper filename))
[director (make-stepper filename)] (define local-debugging? debugging?)
[debugging? debugging?]) (define (call-without-debugging thunk)
(set! current-stepper-director director) (let ([eo (current-expand-observe)]
(values [saved-debugging? local-debugging?])
(lambda (expr) (dynamic-wind
(if (and debugging? (syntax? expr)) (lambda ()
(let-values ([(e-expr events derivp) (trace* expr expand)]) (set! local-debugging? #f)
(show-deriv director events) (when eo (current-expand-observe void)))
(if (syntax? e-expr) thunk
(parameterize ((current-eval original-eval-handler)) (lambda ()
(original-eval-handler e-expr)) (set! local-debugging? saved-debugging?)
(raise e-expr))) (when eo (current-expand-observe eo))))))
(original-eval-handler expr))) (define (the-eval expr)
(lambda args (if (and local-debugging? (syntax? expr))
(let ([eo (current-expand-observe)] (let-values ([(e-expr events derivp) (trace* expr expand)])
[saved-debugging? debugging?]) (show-deriv director events)
(dynamic-wind (if (syntax? e-expr)
(lambda () (inner-eval e-expr)
(set! debugging? #f) (raise e-expr)))
(when eo (current-expand-observe void))) (original-eval-handler expr)))
(lambda () (define (inner-eval e-expr)
(apply original-module-name-resolver args)) (if #f ;; fixme: turn into parameter/preference???
(lambda () (call-without-debugging (lambda () (original-eval-handler e-expr)))
(set! debugging? saved-debugging?) (original-eval-handler e-expr)))
(when eo (current-expand-observe eo))))))))) (define (the-module-resolver . args)
(call-without-debugging
(lambda () (apply original-module-name-resolver args))))
(set! current-stepper-director director)
(values the-eval
the-module-resolver))
(define/private (show-deriv director events) (define/private (show-deriv director events)
(parameterize ([current-eventspace drscheme-eventspace]) (parameterize ([current-eventspace drscheme-eventspace])