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

macro-stepper: better styling of errors, reduction steps

Browse Source
This commit is contained in:
Ryan Culpepper 2011-11-29 19:52:26 -07:00
parent df3a9d8c7f
commit 5c20a46c3a
2 changed files with 12 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/macro-debugger/view/step-display.rkt
View File

@ -118,14 +118,10 @@
(state-uses state) (state-uses state)
(state-frontier state)))) (state-frontier state))))
;; separator : Step -> void ;; separator : Step [...] -> void
(define/private (separator step) (define/private (separator step #:compact? [compact? #f])
(insert-step-separator (step-type->string (protostep-type step)))) (insert-step-separator (step-type->string (protostep-type step))
#:compact? compact?))
;; separator/small : Step -> void
(define/private (separator/small step)
(insert-step-separator/small
(step-type->string (protostep-type step))))
;; show-step : Step -> void ;; show-step : Step -> void
(define/private (show-step step shift-table) (define/private (show-step step shift-table)
@ -192,21 +188,20 @@
;; show-prestep : Step -> void ;; show-prestep : Step -> void
(define/private (show-prestep step shift-table) (define/private (show-prestep step shift-table)
(separator/small step) (separator step #:compact? #t)
(show-state/redex (protostep-s1 step) shift-table) (show-state/redex (protostep-s1 step) shift-table)
(show-lctx step shift-table)) (show-lctx step shift-table))
;; show-poststep : Step -> void ;; show-poststep : Step -> void
(define/private (show-poststep step shift-table) (define/private (show-poststep step shift-table)
(separator/small step) (separator step #:compact? #t)
(show-state/contractum (protostep-s1 step) shift-table) (show-state/contractum (protostep-s1 step) shift-table)
(show-lctx step shift-table)) (show-lctx step shift-table))
;; show-misstep : Step -> void ;; show-misstep : Step -> void
(define/private (show-misstep step shift-table) (define/private (show-misstep step shift-table)
(define state (protostep-s1 step)) (define state (protostep-s1 step))
(show-state/redex state shift-table) (separator step #:compact? #t)
(separator step)
(send*/i sbview sb:syntax-browser<%> (send*/i sbview sb:syntax-browser<%>
(add-error-text (exn-message (misstep-exn step))) (add-error-text (exn-message (misstep-exn step)))
(add-text "\n")) (add-text "\n"))
@ -261,33 +256,14 @@
definites frontier "LightCyan")) definites frontier "LightCyan"))
;; insert-step-separator : string -> void ;; insert-step-separator : string -> void
(define/private (insert-step-separator text) (define/private (insert-step-separator text #:compact? compact?)
(send*/i sbview sb:syntax-browser<%> (send*/i sbview sb:syntax-browser<%>
(add-text "\n ") (add-text (if compact? "" "\n"))
(add-text (add-text
(make-object image-snip% (make-object image-snip%
(build-path (collection-path "icons") (build-path (collection-path "icons")
"red-arrow.bmp"))) "red-arrow.bmp")))
(add-text " ") (add-text " [")
(add-text text) (add-text text)
(add-text "\n\n"))) (add-text "]\n\n")))
;; insert-as-separator : string -> void
(define/private (insert-as-separator text)
(send*/i sbview sb:syntax-browser<%>
(add-text "\n ")
(add-text text)
(add-text "\n\n")))
;; insert-step-separator/small : string -> void
(define/private (insert-step-separator/small text)
(send*/i sbview sb:syntax-browser<%>
(add-text " ")
(add-text
(make-object image-snip%
(build-path (collection-path "icons")
"red-arrow.bmp")))
(add-text " ")
(add-text text)
(add-text "\n\n")))
)) ))

3
collects/macro-debugger/view/term-record.rkt
View File

@ -189,8 +189,7 @@
(make poststep type s2) (make poststep type s2)
(loop rs))] (loop rs))]
[(cons (struct misstep (type s1 exn)) rs) [(cons (struct misstep (type s1 exn)) rs)
(list* (make prestep type s1) (list* (make misstep type s1 exn)
(make misstep type s1 exn)
(loop rs))] (loop rs))]
['() ['()
null]))) null])))