62 lines
2.2 KiB
Scheme
62 lines
2.2 KiB
Scheme
|
|
(module warning mzscheme
|
|
(require (lib "class.ss")
|
|
(lib "mred.ss" "mred")
|
|
(lib "framework.ss" "framework"))
|
|
(provide warnings-frame%)
|
|
|
|
(define include-message? #f)
|
|
|
|
;; warnings-frame%
|
|
(define warnings-frame%
|
|
(class frame%
|
|
(super-new (label "Macro stepper warnings") (width 400) (height 300))
|
|
|
|
(define text (new text:hide-caret/selection% (auto-wrap #t)))
|
|
(define ec (new editor-canvas% (parent this) (editor text)))
|
|
(send text lock #t)
|
|
|
|
(define -nonlinearity-text #f)
|
|
(define -localactions-text #f)
|
|
(define -lifts-text #f)
|
|
|
|
(define/private (add-nonlinearity-text)
|
|
(unless -nonlinearity-text
|
|
(set! -nonlinearity-text #t)
|
|
(add-text "An opaque macro duplicated one of its subterms. "
|
|
"Macro hiding requires opaque macros to use their subterms linearly. "
|
|
"The macro stepper is showing the expansion of that macro use.")))
|
|
(define/private (add-localactions-text)
|
|
(unless -localactions-text
|
|
(set! -localactions-text #t)
|
|
(add-text "An opaque macro called local-expand, syntax-local-lift-expression, "
|
|
"etc. Macro hiding cannot currently handle local actions. "
|
|
"The macro stepper is showing the expansion of that macro use.")))
|
|
(define/private (add-lifts-text)
|
|
(unless -lifts-text
|
|
(set! -lifts-text #t)
|
|
(add-text "A transparent macro called syntax-local-lift-expression or "
|
|
"syntax-local-lift-module-end-declaration. "
|
|
"The macro stepper is only hiding macro after the "
|
|
"lifts are caught.")))
|
|
|
|
(define/public (add-text . strs)
|
|
(send text lock #f)
|
|
(for-each (lambda (s) (send text insert s)) strs)
|
|
(send text insert "\n\n")
|
|
(send text lock #t))
|
|
|
|
(define/public (add-warning tag message)
|
|
(case tag
|
|
((nonlinearity)
|
|
(add-nonlinearity-text))
|
|
((localactions)
|
|
(add-localactions-text))
|
|
((lifts)
|
|
(add-lifts-text)))
|
|
(when include-message?
|
|
(add-text message)))
|
|
|
|
(send this show #t)))
|
|
|
|
) |