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

move the with-stack-checkpoint wrapper code into the eval handler

Browse Source 
so tools that override the handler can get direct access to the
unexpanded syntax objects if they want them
This commit is contained in:
Robby Findler 2013-08-28 10:37:10 -05:00
parent 9b99dc2a25
commit abc7f9a873
1 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt
View File

@ -381,6 +381,8 @@ TODO
(define after-expression (make-parameter #f)) (define after-expression (make-parameter #f))
(define do-dance (make-parameter #f))
(define text-mixin (define text-mixin
(mixin ((class->interface text%) (mixin ((class->interface text%)
text:ports<%> text:ports<%>
@ -1087,31 +1089,8 @@ TODO
(define results (define results
(call-with-values (call-with-values
(λ () (λ ()
;; we duplicate the 'expand-syntax-to-top-form' dance that eval-syntax (parameterize ([do-dance #t])
;; does here, so that we can put 'with-stack-checkpoint's in to limit (eval-syntax sexp/syntax/eof)))
;; the amount of DrRacket code we see in stacktraces
(let loop ([stx sexp/syntax/eof])
(define top-expanded (with-stack-checkpoint (expand-syntax-to-top-form stx)))
(syntax-case top-expanded (begin)
[(begin a1 . args)
(let lloop ([args (syntax->list #'(a1 . args))])
(cond
[(null? (cdr args))
(loop (car args))]
[else
(loop (car args))
(lloop (cdr args))]))]
[_
(let ([expanded (with-stack-checkpoint (expand-syntax top-expanded))])
(call-with-continuation-prompt
(λ ()
(with-stack-checkpoint (eval-syntax expanded)))
(default-continuation-prompt-tag)
(λ args
(apply
abort-current-continuation
(default-continuation-prompt-tag)
args))))])))
list)) list))
(parameterize ([pretty-print-columns pretty-print-width]) (parameterize ([pretty-print-columns pretty-print-width])
(for ([x (in-list results)]) (for ([x (in-list results)])
@ -1250,6 +1229,41 @@ TODO
(reset-logger-messages) (reset-logger-messages)
(current-eval
(let ([oe (current-eval)])
(define (drracket-eval-handler sexp/syntax)
(cond
[(do-dance)
;; we duplicate the 'expand-syntax-to-top-form' dance that eval-syntax
;; does here, so that we can put 'with-stack-checkpoint's in to limit
;; the amount of DrRacket code we see in stacktraces
(parameterize ([do-dance #f])
(let loop ([stx sexp/syntax])
(define top-expanded (with-stack-checkpoint (expand-syntax-to-top-form stx)))
(syntax-case top-expanded (begin)
[(begin a1 . args)
(let lloop ([args (syntax->list #'(a1 . args))])
(cond
[(null? (cdr args))
(loop (car args))]
[else
(loop (car args))
(lloop (cdr args))]))]
[_
(let ([expanded (with-stack-checkpoint (expand-syntax top-expanded))])
(call-with-continuation-prompt
(λ ()
(with-stack-checkpoint (oe expanded)))
(default-continuation-prompt-tag)
(λ args
(apply
abort-current-continuation
(default-continuation-prompt-tag)
args))))])))]
[else
(oe sexp/syntax)]))
drracket-eval-handler))
(let* ([init-thread-complete (make-semaphore 0)] (let* ([init-thread-complete (make-semaphore 0)]
[goahead (make-semaphore)]) [goahead (make-semaphore)])