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

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

@ -39,6 +39,8 @@
(define drscheme-macro-stepper-director%
(class macro-stepper-director%
(init-field filename)
(define eventspace (current-eventspace))
(define stepper #f)
(inherit new-stepper)
@ -48,16 +50,23 @@
(define/override (add-trace events)
(lazy-new-stepper)
(super add-trace events))
(parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(super add-trace events)))))
(define/override (add-deriv deriv)
(lazy-new-stepper)
(super add-deriv deriv))
(parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(super add-deriv deriv)))))
(define/override (new-stepper-frame)
(new macro-stepper-frame%
(config (new macro-stepper-config/prefs%))
(filename filename)
(director this)))
(parameterize ((current-eventspace eventspace))
(new macro-stepper-frame%
(config (new macro-stepper-config/prefs%))
(filename filename)
(director this))))
(super-new)))
@ -77,6 +86,7 @@
(define (phase2) (void))
(define drscheme-eventspace (current-eventspace))
(define drscheme-custodian (current-custodian))
(define-local-member-name check-language)
@ -192,7 +202,11 @@
(current-module-name-resolver mnr))))))
(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)
(original-eval-handler e-expr))
@ -234,10 +248,7 @@
the-module-resolver))
(define/private (show-deriv director events)
(parameterize ([current-eventspace drscheme-eventspace])
(queue-callback
(lambda ()
(send director add-trace events)))))
(send director add-trace events))
))
;; Borrowed from mztake/debug-tool.ss