macro-debugger: fixed breakage of stepper-text, expand-only

Please propagate to release branch if possible.

svn: r17852

original commit: 0cea5eb3901d49688d5193e6e508e1ea7e6fa832
This commit is contained in:
Ryan Culpepper 2010-01-27 17:31:22 +00:00
parent 82aed89fa4
commit f616cdbf54
2 changed files with 2 additions and 9 deletions

View File

@ -25,7 +25,7 @@
(define (expand/show-predicate stx show?) (define (expand/show-predicate stx show?)
(let-values ([(result deriv) (trace/result stx)]) (let-values ([(result deriv) (trace/result stx)])
(when (exn? result) (raise result)) (when (exn? result) (raise result))
(let-values ([(_steps _uses stx exn2) (let-values ([(_steps _defs _uses stx exn2)
(parameterize ((macro-policy show?)) (parameterize ((macro-policy show?))
(reductions+ deriv))]) (reductions+ deriv))])
(when (exn? exn2) (raise exn2)) (when (exn? exn2) (raise exn2))

View File

@ -93,13 +93,6 @@
((if display-like? display write) (syntax-dummy-val obj) port)] ((if display-like? display write) (syntax-dummy-val obj) port)]
[else [else
(error 'pretty-print-hook "unexpected special value: ~e" obj)])) (error 'pretty-print-hook "unexpected special value: ~e" obj)]))
(define (pp-extend-style-table)
(let* ([ids identifier-list]
[syms (map (lambda (x) (hash-ref stx=>flat x)) ids)]
[like-syms (map syntax-e ids)])
(pretty-print-extend-style-table (pp-better-style-table)
syms
like-syms)))
(define (pp-better-style-table) (define (pp-better-style-table)
(pretty-print-extend-style-table (pretty-print-current-style-table) (pretty-print-extend-style-table (pretty-print-current-style-table)
(map car extended-style-list) (map car extended-style-list)
@ -107,7 +100,7 @@
(parameterize (parameterize
([pretty-print-size-hook pp-size-hook] ([pretty-print-size-hook pp-size-hook]
[pretty-print-print-hook pp-print-hook] [pretty-print-print-hook pp-print-hook]
[pretty-print-current-style-table (pp-extend-style-table)]) [pretty-print-current-style-table (pp-better-style-table)])
(pretty-print/defaults datum))) (pretty-print/defaults datum)))
(define (->show-function show) (define (->show-function show)