132 lines
4.0 KiB
Scheme
132 lines
4.0 KiB
Scheme
|
|
(module warning mzscheme
|
|
(require mzlib/class
|
|
mred
|
|
framework)
|
|
(provide warnings%
|
|
stepper-warnings%)
|
|
|
|
;; warnings%
|
|
(define warnings%
|
|
(class object%
|
|
(init parent)
|
|
(super-new)
|
|
|
|
(define super-panel
|
|
(new vertical-panel%
|
|
(parent parent)
|
|
(stretchable-height #f)))
|
|
(define main-panel
|
|
(new horizontal-panel%
|
|
(parent super-panel)
|
|
(style '(deleted border))))
|
|
(define label (new message% (parent main-panel) (label "Warnings")))
|
|
(define text (new text:hide-caret/selection% (auto-wrap #t)))
|
|
(define ec
|
|
(new editor-canvas%
|
|
(parent main-panel)
|
|
(editor text)
|
|
(style '(auto-vscroll auto-hscroll))
|
|
(line-count 3)))
|
|
(define dismiss
|
|
(new button%
|
|
(parent main-panel)
|
|
(label "Hide")
|
|
(stretchable-height #t)
|
|
(callback (lambda _ (show #f)))))
|
|
(send text set-autowrap-bitmap #f)
|
|
(send text lock #t)
|
|
|
|
(define/public (get-text) text)
|
|
|
|
(define/public (show ?)
|
|
(send super-panel change-children
|
|
(lambda _
|
|
(if ?
|
|
(list main-panel)
|
|
null))))
|
|
|
|
;; Warning management
|
|
(define keys null)
|
|
|
|
;; clear : -> void
|
|
(define/public (clear)
|
|
(set! keys null)
|
|
(send* text
|
|
(lock #f)
|
|
(erase)
|
|
(lock #t))
|
|
(show #f))
|
|
|
|
;; add : symbol string ... -> void
|
|
(define/public (add key . strs)
|
|
(unless (memq key keys)
|
|
(send text lock #f)
|
|
(for-each (lambda (s) (send text insert s)) strs)
|
|
(send text insert "\n\n")
|
|
(send text scroll-to-position 0)
|
|
(send text lock #t)
|
|
(show #t)))
|
|
|
|
))
|
|
|
|
(define stepper-warnings%
|
|
(class warnings%
|
|
(super-new)
|
|
(inherit add)
|
|
|
|
(define/private (add-nonlinearity-warning)
|
|
(add
|
|
'nonlinearity
|
|
"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-warning)
|
|
(add
|
|
'localactions
|
|
"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-warning)
|
|
(add
|
|
'lifts
|
|
"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/private (add-lift/let-warning)
|
|
(add
|
|
'lift/let
|
|
"Lifts occurred during the expansion of phase 1 or higher code. "
|
|
"The macro stepper is showing some expansions that should be hidden."))
|
|
|
|
(define/private (add-hidden-lift-site-warning)
|
|
(add
|
|
'hidden-lift-site
|
|
"An opaque macro contained the target of a lifted declaration."
|
|
"The macro stepper is showing the expansion of that macro use."))
|
|
|
|
(define/private (add-hidden-lift-site/continuing-warning)
|
|
(add
|
|
'hidden-lift-site/continuing
|
|
"The target of a lifted declaration was a hidden #%module-begin context. "
|
|
"The macro stepper is omitting the lifted declaration."))
|
|
|
|
(define/public (add-warning tag args)
|
|
(case tag
|
|
((nonlinearity)
|
|
(add-nonlinearity-warning))
|
|
((localactions)
|
|
(add-localactions-warning))
|
|
((lifts)
|
|
(add-lifts-warning))
|
|
((lift/let)
|
|
(add-lift/let-warning))
|
|
((hidden-lift-site)
|
|
(add-hidden-lift-site-warning))
|
|
((hidden-lift-site/continuing)
|
|
(add-hidden-lift-site/continuing-warning))))
|
|
))
|
|
)
|