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

macro-debugger: create new eventspace for macro stepper

Browse Source 
svn: r15882
This commit is contained in:
Ryan Culpepper 2009-09-04 21:56:17 +00:00
parent 5f688d1144
commit 985bf7bd11
1 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,6 +39,8 @@
(define drscheme-macro-stepper-director% (define drscheme-macro-stepper-director%
(class macro-stepper-director% (class macro-stepper-director%
(init-field filename) (init-field filename)
(define eventspace (current-eventspace))
(define stepper #f) (define stepper #f)
(inherit new-stepper) (inherit new-stepper)
@ -48,16 +50,23 @@
(define/override (add-trace events) (define/override (add-trace events)
(lazy-new-stepper) (lazy-new-stepper)
(super add-trace events)) (parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(super add-trace events)))))
(define/override (add-deriv deriv) (define/override (add-deriv deriv)
(lazy-new-stepper) (lazy-new-stepper)
(super add-deriv deriv)) (parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(super add-deriv deriv)))))
(define/override (new-stepper-frame) (define/override (new-stepper-frame)
(new macro-stepper-frame% (parameterize ((current-eventspace eventspace))
(config (new macro-stepper-config/prefs%)) (new macro-stepper-frame%
(filename filename) (config (new macro-stepper-config/prefs%))
(director this))) (filename filename)
(director this))))
(super-new))) (super-new)))
@ -77,6 +86,7 @@
(define (phase2) (void)) (define (phase2) (void))
(define drscheme-eventspace (current-eventspace)) (define drscheme-eventspace (current-eventspace))
(define drscheme-custodian (current-custodian))
(define-local-member-name check-language) (define-local-member-name check-language)
@ -179,7 +189,7 @@
(when current-stepper-director (when current-stepper-director
(send current-stepper-director add-obsoleted-warning) (send current-stepper-director add-obsoleted-warning)
(set! current-stepper-director #f)) (set! current-stepper-director #f))
;; setting the eval handler at this point disables CM, ;; setting the eval handler at this point disables CM,
;; so only do it when we are debugging ;; so only do it when we are debugging
(when debugging? (when debugging?
@ -192,7 +202,11 @@
(current-module-name-resolver mnr)))))) (current-module-name-resolver mnr))))))
(define/private (make-stepper filename) (define/private (make-stepper filename)
(new drscheme-macro-stepper-director% (filename filename))) (parameterize ((current-eventspace
(parameterize ((current-eventspace drscheme-eventspace)
(current-custodian drscheme-custodian))
(make-eventspace))))
(new drscheme-macro-stepper-director% (filename filename))))
(define/private (inner-eval original-eval-handler e-expr) (define/private (inner-eval original-eval-handler e-expr)
(original-eval-handler e-expr)) (original-eval-handler e-expr))
@ -234,10 +248,7 @@
the-module-resolver)) the-module-resolver))
(define/private (show-deriv director events) (define/private (show-deriv director events)
(parameterize ([current-eventspace drscheme-eventspace]) (send director add-trace events))
(queue-callback
(lambda ()
(send director add-trace events)))))
)) ))
;; Borrowed from mztake/debug-tool.ss ;; Borrowed from mztake/debug-tool.ss