From ef1cb082dd70f8eec2c849090bbc34e231b6f989 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Sat, 15 Sep 2007 16:10:39 +0000 Subject: [PATCH] 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 --- collects/lang/htdp-langs.ss | 14 +- collects/mztake/debug-tool.ss | 22 +- .../stepper/stepper-language-interface.ss | 4 +- collects/stepper/stepper-tool.ss | 213 +++++++++--------- .../english-string-constants.ss | 3 +- 5 files changed, 134 insertions(+), 122 deletions(-) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index d08f283642..ccdfd56f1d 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -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) diff --git a/collects/mztake/debug-tool.ss b/collects/mztake/debug-tool.ss index 82f887969e..07febfe0d4 100644 --- a/collects/mztake/debug-tool.ss +++ b/collects/mztake/debug-tool.ss @@ -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))) diff --git a/collects/stepper/stepper-language-interface.ss b/collects/stepper/stepper-language-interface.ss index 1cbe998560..4d0202d2ca 100644 --- a/collects/stepper/stepper-language-interface.ss +++ b/collects/stepper/stepper-language-interface.ss @@ -4,4 +4,6 @@ (provide stepper-language<%>) (define stepper-language<%> - (interface () stepper:enable-let-lifting?))) \ No newline at end of file + (interface () + stepper:supported? + stepper:enable-let-lifting?))) diff --git a/collects/stepper/stepper-tool.ss b/collects/stepper/stepper-tool.ss index ff150f906c..db5724aed9 100644 --- a/collects/stepper/stepper-tool.ss +++ b/collects/stepper/stepper-tool.ss @@ -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)]))) + +) diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index 55f947b086..ade90467b6 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -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")