macro-debugger:

fixed internal error in reporting internal errors
  made debug files more readable
  fixed wrong ordering of local contexts

svn: r18328

original commit: e6c4518ae8dba118e03632a0cfc66c939a75755e
This commit is contained in:
Ryan Culpepper 2010-02-24 21:39:16 +00:00
commit 3ce3c33b95
3 changed files with 20 additions and 16 deletions

View File

@ -7,13 +7,15 @@
(define (write-debug-file file exn events) (define (write-debug-file file exn events)
(with-output-to-file file (with-output-to-file file
(lambda () (lambda ()
(write `(list ,@(map (lambda (e) (serialize-datum e)) events))) (pretty-print
`(list ,@(map (lambda (e) (serialize-datum e)) events)))
(newline) (newline)
(write (exn-message exn)) (write (exn-message exn))
(newline) (newline)
(write (map serialize-context-frame (pretty-print
(continuation-mark-set->context (map serialize-context-frame
(exn-continuation-marks exn))))) (continuation-mark-set->context
(exn-continuation-marks exn)))))
#:exists 'replace)) #:exists 'replace))
(define (serialize-datum d) (define (serialize-datum d)

View File

@ -119,17 +119,15 @@
(define/private (show-lctx step shift-table) (define/private (show-lctx step shift-table)
(define state (protostep-s1 step)) (define state (protostep-s1 step))
(define lctx (state-lctx state)) (define lctx (state-lctx state))
(when (pair? lctx) (for ([bf lctx])
(send: sbview sb:syntax-browser<%> add-text "\n") (send: sbview sb:syntax-browser<%> add-text
(for ([bf (reverse lctx)]) "\nwhile executing macro transformer in:\n")
(send: sbview sb:syntax-browser<%> add-text (insert-syntax/redex (bigframe-term bf)
"while executing macro transformer in:\n") (bigframe-foci bf)
(insert-syntax/redex (bigframe-term bf) (state-binders state)
(bigframe-foci bf) shift-table
(state-binders state) (state-uses state)
shift-table (state-frontier state))))
(state-uses state)
(state-frontier state)))))
;; separator : Step -> void ;; separator : Step -> void
(define/private (separator step) (define/private (separator step)

View File

@ -275,7 +275,11 @@
;; display-initial-term : -> void ;; display-initial-term : -> void
(define/public (display-initial-term) (define/public (display-initial-term)
(send: displayer step-display<%> add-syntax (wderiv-e1 deriv))) (cond [raw-deriv-oops
(send: displayer step-display<%> add-internal-error
"derivation" raw-deriv-oops #f events)]
[else
(send: displayer step-display<%> add-syntax (wderiv-e1 deriv))]))
;; display-final-term : -> void ;; display-final-term : -> void
(define/public (display-final-term) (define/public (display-final-term)