Various aspects of the Stepper and the Debugger are
language-sensitive. In the past, both looked at the name of the language level and were thus were hardwired to certain behavior. Move some of those settings into the language level itself: - whether the stepper is supported (default #f) - whether the debugger is supported (default #t) - the print conversion of values for the stepper This allows other language levels such as the DMdA levels to support the stepper and not support the debugger. svn: r7346
This commit is contained in:
Mike Sperber
parent
78b57246a2
commit
ef1cb082dd
|
|
@ -876,9 +876,14 @@
|
|||
|
||||
(define (stepper-settings-language %)
|
||||
(class* % (stepper-language<%>)
|
||||
(init-field stepper:supported)
|
||||
(init-field stepper:enable-let-lifting)
|
||||
(inherit [dontcare stepper:enable-let-lifting?])
|
||||
(inherit [dontcare1 stepper:enable-let-lifting?]
|
||||
[dontcare2 stepper:supported?]
|
||||
[dontcare3 debugger:supported?])
|
||||
(define/override (stepper:supported?) stepper:supported)
|
||||
(define/override (stepper:enable-let-lifting?) stepper:enable-let-lifting)
|
||||
(define/override (debugger:supported?) #f)
|
||||
(super-new)))
|
||||
|
||||
;; rewrite-module : settings syntax -> syntax
|
||||
|
|
@ -1375,7 +1380,8 @@
|
|||
(abbreviate-cons-as-list #t)
|
||||
(allow-sharing? #t)
|
||||
(reader-module '(lib "htdp-advanced-reader.ss" "lang"))
|
||||
(stepper:enable-let-lifting #t)))
|
||||
(stepper:supported #f)
|
||||
(stepper:enable-let-lifting #t)))
|
||||
|
||||
(add-htdp-language
|
||||
(instantiate htdp-language% ()
|
||||
|
|
@ -1401,6 +1407,7 @@
|
|||
(abbreviate-cons-as-list #t)
|
||||
(allow-sharing? #f)
|
||||
(reader-module '(lib "htdp-intermediate-lambda-reader.ss" "lang"))
|
||||
(stepper:supported #t)
|
||||
(stepper:enable-let-lifting #t)))
|
||||
|
||||
(add-htdp-language
|
||||
|
|
@ -1419,6 +1426,7 @@
|
|||
(allow-sharing? #f)
|
||||
(use-function-output-syntax? #t)
|
||||
(reader-module '(lib "htdp-intermediate-reader.ss" "lang"))
|
||||
(stepper:supported #t)
|
||||
(stepper:enable-let-lifting #t)))
|
||||
|
||||
(add-htdp-language
|
||||
|
|
@ -1436,6 +1444,7 @@
|
|||
(abbreviate-cons-as-list #t)
|
||||
(allow-sharing? #f)
|
||||
(reader-module '(lib "htdp-beginner-abbr-reader.ss" "lang"))
|
||||
(stepper:supported #t)
|
||||
(stepper:enable-let-lifting #t)))
|
||||
|
||||
(add-htdp-language
|
||||
|
|
@ -1454,6 +1463,7 @@
|
|||
(allow-sharing? #f)
|
||||
(accept-quasiquote? #f)
|
||||
(reader-module '(lib "htdp-beginner-reader.ss" "lang"))
|
||||
(stepper:supported #t)
|
||||
(stepper:enable-let-lifting #t)))
|
||||
|
||||
(drscheme:get/extend:extend-unit-frame frame-tracing-mixin)
|
||||
|
|
|
|||
|
|
@ -29,19 +29,25 @@
|
|||
(unit
|
||||
(import drscheme:tool^)
|
||||
(export drscheme:tool-exports^)
|
||||
(define phase1 void)
|
||||
|
||||
(define debugger-language<%>
|
||||
(interface () debugger:supported?))
|
||||
|
||||
(define (phase1)
|
||||
(drscheme:language:extend-language-interface
|
||||
debugger-language<%>
|
||||
(lambda (superclass)
|
||||
(class* superclass (debugger-language<%>)
|
||||
(public debugger:supported?)
|
||||
(define (debugger:supported?) #t)
|
||||
(super-instantiate ())))))
|
||||
(define phase2 void)
|
||||
|
||||
(define (extract-language-level settings)
|
||||
(let* ([language (drscheme:language-configuration:language-settings-language settings)])
|
||||
(car (last-pair (send language get-language-position)))))
|
||||
(drscheme:language-configuration:language-settings-language settings))
|
||||
|
||||
(define (debugger-does-not-work-for? lang)
|
||||
(member lang (list (string-constant beginning-student)
|
||||
(string-constant beginning-student/abbrev)
|
||||
(string-constant intermediate-student)
|
||||
(string-constant intermediate-student/lambda)
|
||||
(string-constant advanced-student))))
|
||||
(not (send lang debugger:supported?)))
|
||||
|
||||
(define (robust-syntax-source stx)
|
||||
(and (syntax? stx) (syntax-source stx)))
|
||||
|
|
|
|||
|
|
@ -4,4 +4,6 @@
|
|||
(provide stepper-language<%>)
|
||||
|
||||
(define stepper-language<%>
|
||||
(interface () stepper:enable-let-lifting?)))
|
||||
(interface ()
|
||||
stepper:supported?
|
||||
stepper:enable-let-lifting?)))
|
||||
|
|
|
|||
|
|
@ -18,17 +18,10 @@
|
|||
"stepper-language-interface.ss"
|
||||
"xml-sig.ss")
|
||||
|
||||
;; hidden invariant: this list should be a sublist of the language-level
|
||||
;; dialog (i.e., same order):
|
||||
(define stepper-works-for
|
||||
(list (string-constant beginning-student)
|
||||
(string-constant beginning-student/abbrev)
|
||||
(string-constant intermediate-student)
|
||||
(string-constant intermediate-student/lambda)
|
||||
#;(string-constant advanced-student)
|
||||
))
|
||||
|
||||
(provide stepper-tool@)
|
||||
(provide stepper-tool@
|
||||
make-print-convert-hook
|
||||
set-print-settings
|
||||
simple-module-based-language-convert-value)
|
||||
|
||||
(define-unit stepper-tool@
|
||||
(import drscheme:tool^ xml^)
|
||||
|
|
@ -42,8 +35,23 @@
|
|||
stepper-language<%>
|
||||
(lambda (superclass)
|
||||
(class* superclass (stepper-language<%>)
|
||||
(public stepper:supported?)
|
||||
(define (stepper:supported?) #f)
|
||||
(public stepper:enable-let-lifting?)
|
||||
(define (stepper:enable-let-lifting?) #f)
|
||||
(public stepper:render-to-sexp)
|
||||
(define (stepper:render-to-sexp val settings language-level)
|
||||
(parameterize ([current-print-convert-hook
|
||||
(make-print-convert-hook settings)])
|
||||
(set-print-settings
|
||||
language-level
|
||||
settings
|
||||
(lambda ()
|
||||
(simple-module-based-language-convert-value
|
||||
val
|
||||
(drscheme:language:simple-settings-printing-style settings)
|
||||
(drscheme:language:simple-settings-show-sharing settings))))))
|
||||
|
||||
(super-instantiate ())))))
|
||||
|
||||
(define (phase2) (void))
|
||||
|
|
@ -63,9 +71,9 @@
|
|||
(define (settings->language-level settings)
|
||||
(drscheme:language-configuration:language-settings-language settings))
|
||||
|
||||
(define (stepper-works-for? language-level-name)
|
||||
(or (member language-level-name stepper-works-for)
|
||||
(getenv "PLTSTEPPERUNSAFE")))
|
||||
(define (stepper-works-for? language-level)
|
||||
(or (send language-level stepper:supported?)
|
||||
(getenv "PLTSTEPPERUNSAFE")))
|
||||
|
||||
;; the stepper's frame:
|
||||
(define stepper-frame%
|
||||
|
|
@ -173,49 +181,9 @@
|
|||
(send language-level render-value val simple-settings string-port)
|
||||
(get-output-string string-port)))
|
||||
|
||||
;; WE REALLY WANT TO GET RID OF THIS STUFF (2005-07-01, JBC)
|
||||
|
||||
;; make-print-convert-hook:
|
||||
;; simple-settings -> (TST (TST -> TST) (TST -> TST) -> TST)
|
||||
;; this code copied from various locations in language.ss and rep.ss
|
||||
(define (make-print-convert-hook simple-settings)
|
||||
(lambda (exp basic-convert sub-convert)
|
||||
(cond
|
||||
[(is-a? exp snip%)
|
||||
(send exp copy)]
|
||||
#;
|
||||
[((drscheme:rep:use-number-snip) exp)
|
||||
(let ([number-snip-type
|
||||
(drscheme:language:simple-settings-fraction-style
|
||||
simple-settings)])
|
||||
(cond
|
||||
[(eq? number-snip-type 'repeating-decimal)
|
||||
(drscheme:number-snip:make-repeating-decimal-snip exp #f)]
|
||||
[(eq? number-snip-type 'repeating-decimal-e)
|
||||
(drscheme:number-snip:make-repeating-decimal-snip exp #t)]
|
||||
[(eq? number-snip-type 'mixed-fraction)
|
||||
(drscheme:number-snip:make-fraction-snip exp #f)]
|
||||
[(eq? number-snip-type 'mixed-fraction-e)
|
||||
(drscheme:number-snip:make-fraction-snip exp #t)]
|
||||
[else
|
||||
(error 'which-number-snip
|
||||
"expected either 'repeating-decimal, 'repeating-decimal-e, 'mixed-fraction, or 'mixed-fraction-e got : ~e"
|
||||
number-snip-type)]))]
|
||||
[else (basic-convert exp)])))
|
||||
|
||||
;; render-to-sexp : TST -> sexp
|
||||
(define (render-to-sexp val)
|
||||
(cond
|
||||
[(string=? language-level-name "ACL2 Beginner (beta 8)")
|
||||
(simple-module-based-language-convert-value val simple-settings)]
|
||||
[else (parameterize ([current-print-convert-hook
|
||||
(make-print-convert-hook simple-settings)])
|
||||
(set-print-settings
|
||||
language-level
|
||||
simple-settings
|
||||
(lambda ()
|
||||
(simple-module-based-language-convert-value
|
||||
val simple-settings))))]))
|
||||
(send language-level stepper:render-to-sexp val simple-settings language-level))
|
||||
|
||||
;; channel for incoming views
|
||||
(define view-channel (make-async-channel))
|
||||
|
|
@ -564,18 +532,16 @@
|
|||
(lambda (button evt)
|
||||
(if stepper-frame
|
||||
(send stepper-frame show #t)
|
||||
(let ([language-level-name
|
||||
(language-level->name
|
||||
(extract-language-level (get-definitions-text)))])
|
||||
(if (stepper-works-for? language-level-name)
|
||||
(let* ([language-level
|
||||
(extract-language-level (get-definitions-text))]
|
||||
[language-level-name (language-level->name language-level)])
|
||||
(if (stepper-works-for? language-level)
|
||||
(set! stepper-frame
|
||||
(view-controller-go this program-expander))
|
||||
(message-box
|
||||
(string-constant stepper-name)
|
||||
(format (string-constant stepper-language-level-message)
|
||||
language-level-name
|
||||
(car stepper-works-for)
|
||||
(car (reverse stepper-works-for))))))))))
|
||||
language-level-name))))))))
|
||||
|
||||
(define/augment (enable-evaluation)
|
||||
(send stepper-button enable #t)
|
||||
|
|
@ -596,8 +562,7 @@
|
|||
|
||||
(define/public (check-current-language-for-stepper)
|
||||
(if (stepper-works-for?
|
||||
(language-level->name
|
||||
(extract-language-level (get-definitions-text))))
|
||||
(extract-language-level (get-definitions-text)))
|
||||
(unless (send stepper-button is-shown?)
|
||||
(send (send stepper-button get-parent)
|
||||
add-child stepper-button))
|
||||
|
|
@ -642,54 +607,84 @@
|
|||
|
||||
(super-new)))
|
||||
|
||||
;; COPIED FROM drscheme/private/language.ss
|
||||
;; simple-module-based-language-convert-value : TST settings -> TST
|
||||
(define (simple-module-based-language-convert-value value settings)
|
||||
(define ((leave-snips-alone-hook sh) expr basic-convert sub-convert)
|
||||
(if (or (is-a? expr snip%)
|
||||
;; FIXME: internal in language.ss (to-snip-value? expr)
|
||||
)
|
||||
expr
|
||||
(sh expr basic-convert sub-convert)))
|
||||
;; mflatt: MINOR HACK - work around temporary
|
||||
;; print-convert problems
|
||||
(define (stepper-print-convert v)
|
||||
(or (and (procedure? v) (object-name v))
|
||||
(print-convert v)))
|
||||
|
||||
(case (drscheme:language:simple-settings-printing-style settings)
|
||||
[(write) value]
|
||||
[(current-print) value]
|
||||
[(constructor)
|
||||
(parameterize
|
||||
([constructor-style-printing #t]
|
||||
[show-sharing
|
||||
(drscheme:language:simple-settings-show-sharing settings)]
|
||||
[current-print-convert-hook
|
||||
(leave-snips-alone-hook (current-print-convert-hook))])
|
||||
(stepper-print-convert value))]
|
||||
[(quasiquote)
|
||||
(parameterize
|
||||
([constructor-style-printing #f]
|
||||
[show-sharing
|
||||
(drscheme:language:simple-settings-show-sharing settings)]
|
||||
[current-print-convert-hook
|
||||
(leave-snips-alone-hook (current-print-convert-hook))])
|
||||
(stepper-print-convert value))]
|
||||
[else (error "Internal stepper error: time to resync with simple-module-based-language-convert-value")]))
|
||||
|
||||
;; set-print-settings ; settings ( -> TST) -> TST
|
||||
(define (set-print-settings language simple-settings thunk)
|
||||
(if (method-in-interface? 'set-printing-parameters (object-interface language))
|
||||
(send language set-printing-parameters simple-settings thunk)
|
||||
;; assume that the current print-convert context is fine
|
||||
;; (error 'stepper-tool "language object does not contain set-printing-parameters method")
|
||||
(thunk)))
|
||||
|
||||
;; apply the mixins dynamically to the drscheme unit frame and
|
||||
;; definitions text:
|
||||
(drscheme:get/extend:extend-unit-frame stepper-unit-frame-mixin)
|
||||
(drscheme:get/extend:extend-definitions-text
|
||||
stepper-definitions-text-mixin)
|
||||
|
||||
))
|
||||
)
|
||||
|
||||
;; COPIED FROM drscheme/private/language.ss
|
||||
;; simple-module-based-language-convert-value : TST STYLE boolean -> TST
|
||||
(define (simple-module-based-language-convert-value value style show-sharing?)
|
||||
(define ((leave-snips-alone-hook sh) expr basic-convert sub-convert)
|
||||
(if (or (is-a? expr snip%)
|
||||
;; FIXME: internal in language.ss (to-snip-value? expr)
|
||||
)
|
||||
expr
|
||||
(sh expr basic-convert sub-convert)))
|
||||
;; mflatt: MINOR HACK - work around temporary
|
||||
;; print-convert problems
|
||||
(define (stepper-print-convert v)
|
||||
(or (and (procedure? v) (object-name v))
|
||||
(print-convert v)))
|
||||
|
||||
(case style
|
||||
[(write) value]
|
||||
[(current-print) value]
|
||||
[(constructor)
|
||||
(parameterize
|
||||
([constructor-style-printing #t]
|
||||
[show-sharing show-sharing?]
|
||||
[current-print-convert-hook
|
||||
(leave-snips-alone-hook (current-print-convert-hook))])
|
||||
(stepper-print-convert value))]
|
||||
[(quasiquote)
|
||||
(parameterize
|
||||
([constructor-style-printing #f]
|
||||
[show-sharing show-sharing?]
|
||||
[current-print-convert-hook
|
||||
(leave-snips-alone-hook (current-print-convert-hook))])
|
||||
(stepper-print-convert value))]
|
||||
[else (error "Internal stepper error: time to resync with simple-module-based-language-convert-value")]))
|
||||
|
||||
;; set-print-settings ; settings ( -> TST) -> TST
|
||||
(define (set-print-settings language simple-settings thunk)
|
||||
(if (method-in-interface? 'set-printing-parameters (object-interface language))
|
||||
(send language set-printing-parameters simple-settings thunk)
|
||||
;; assume that the current print-convert context is fine
|
||||
;; (error 'stepper-tool "language object does not contain set-printing-parameters method")
|
||||
(thunk)))
|
||||
|
||||
;; WE REALLY WANT TO GET RID OF THIS STUFF (2005-07-01, JBC)
|
||||
|
||||
;; make-print-convert-hook:
|
||||
;; simple-settings -> (TST (TST -> TST) (TST -> TST) -> TST)
|
||||
;; this code copied from various locations in language.ss and rep.ss
|
||||
(define (make-print-convert-hook simple-settings)
|
||||
(lambda (exp basic-convert sub-convert)
|
||||
(cond
|
||||
[(is-a? exp snip%)
|
||||
(send exp copy)]
|
||||
#;
|
||||
[((drscheme:rep:use-number-snip) exp)
|
||||
(let ([number-snip-type
|
||||
(drscheme:language:simple-settings-fraction-style
|
||||
simple-settings)])
|
||||
(cond
|
||||
[(eq? number-snip-type 'repeating-decimal)
|
||||
(drscheme:number-snip:make-repeating-decimal-snip exp #f)]
|
||||
[(eq? number-snip-type 'repeating-decimal-e)
|
||||
(drscheme:number-snip:make-repeating-decimal-snip exp #t)]
|
||||
[(eq? number-snip-type 'mixed-fraction)
|
||||
(drscheme:number-snip:make-fraction-snip exp #f)]
|
||||
[(eq? number-snip-type 'mixed-fraction-e)
|
||||
(drscheme:number-snip:make-fraction-snip exp #t)]
|
||||
[else
|
||||
(error 'which-number-snip
|
||||
"expected either 'repeating-decimal, 'repeating-decimal-e, 'mixed-fraction, or 'mixed-fraction-e got : ~e"
|
||||
number-snip-type)]))]
|
||||
[else (basic-convert exp)])))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1189,8 +1189,7 @@ please adhere to these guidelines:
|
|||
(stepper-program-window-closed "WARNING: The program window is gone.")
|
||||
|
||||
(stepper-name "Stepper")
|
||||
(stepper-language-level-message
|
||||
"The language level is set to \"~a\". Currently, the stepper works only for the \"~a\" through the \"~a\" language levels.")
|
||||
(stepper-language-level-message "The stepper does not work for language \"~a\".")
|
||||
(stepper-button-label "Step")
|
||||
(stepper-home "Home")
|
||||
(stepper-previous-application "|< Application")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user