diff --git a/collects/drracket/private/eval-helpers.rkt b/collects/drracket/private/eval-helpers.rkt index 8b5b8a5e75..f9ee323d9e 100644 --- a/collects/drracket/private/eval-helpers.rkt +++ b/collects/drracket/private/eval-helpers.rkt @@ -33,7 +33,8 @@ collection-paths compilation-on? full-trace? - annotations) + annotations + enforce-module-constants) #:prefab) (define orig-namespace (current-namespace)) @@ -69,7 +70,7 @@ (current-library-collection-paths cpaths)) (compile-context-preservation-enabled (prefab-module-settings-full-trace? settings)) - + (compile-enforce-module-constants (prefab-module-settings-enforce-module-constants settings)) (when (prefab-module-settings-compilation-on? settings) (define open-pkgs (for/fold ([s (set)]) ([path (in-list currently-open-files)]) diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index 607d1788e2..3b097e8f85 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -114,18 +114,21 @@ ;; command-line-args : (vectorof string) ;; auto-text : string (define-struct (module-language-settings drracket:language:simple-settings) - (collection-paths command-line-args auto-text compilation-on? full-trace? submodules-to-run)) + (collection-paths command-line-args auto-text compilation-on? full-trace? submodules-to-run + enforce-module-constants)) (define (module-language-settings->prefab-module-settings settings) (prefab-module-settings (module-language-settings-command-line-args settings) (module-language-settings-collection-paths settings) (module-language-settings-compilation-on? settings) (module-language-settings-full-trace? settings) - (drracket:language:simple-settings-annotations settings))) + (drracket:language:simple-settings-annotations settings) + (module-language-settings-enforce-module-constants settings))) (define default-compilation-on? #t) (define default-full-trace? #t) (define default-submodules-to-run (list '(main) '(test))) + (define default-enforce-module-constants #t) (define (get-default-auto-text) (preferences:get 'drracket:module-language:auto-text)) ;; module-mixin : (implements drracket:language:language<%>) @@ -247,7 +250,8 @@ (get-default-auto-text) default-compilation-on? default-full-trace? - default-submodules-to-run))) + default-submodules-to-run + default-enforce-module-constants))) ;; default-settings? : -> boolean (define/override (default-settings? settings) @@ -267,7 +271,9 @@ (equal? (module-language-settings-full-trace? settings) default-full-trace?) (equal? (module-language-settings-submodules-to-run settings) - default-submodules-to-run))) + default-submodules-to-run) + (equal? (module-language-settings-enforce-module-constants settings) + default-enforce-module-constants))) (define/override (marshall-settings settings) (let ([super-marshalled (super marshall-settings settings)]) @@ -277,7 +283,8 @@ (module-language-settings-auto-text settings) (module-language-settings-compilation-on? settings) (module-language-settings-full-trace? settings) - (module-language-settings-submodules-to-run settings)))) + (module-language-settings-submodules-to-run settings) + (module-language-settings-enforce-module-constants settings)))) (define/override (unmarshall-settings marshalled) (and (list? marshalled) @@ -297,7 +304,10 @@ (list-ref marshalled 5))] [submodules-to-run (if (<= marshalled-len 6) default-submodules-to-run - (list-ref marshalled 6))]) + (list-ref marshalled 6))] + [enforce-module-constants (if (<= marshalled-len 7) + default-enforce-module-constants + (list-ref marshalled 7))]) (and (list? collection-paths) (andmap (λ (x) (or (string? x) (symbol? x))) collection-paths) @@ -306,6 +316,7 @@ (string? auto-text) (boolean? compilation-on?) ((listof (listof symbol?)) submodules-to-run) + (boolean? enforce-module-constants) (let ([super (super unmarshall-settings (let ([p (car marshalled)]) ;; Convert 'write to 'print: @@ -331,7 +342,8 @@ compilation-on?) full-trace? - submodules-to-run))))))))))) + submodules-to-run + enforce-module-constants))))))))))) (define/override (on-execute settings run-in-user-thread) (super on-execute settings run-in-user-thread) @@ -612,6 +624,7 @@ [stretchable-height #f] [stretchable-width #f])) (define compilation-on-check-box #f) + (define enforce-module-constants-checkbox #f) (define compilation-on? #t) (define save-stacktrace-on-check-box #f) (define run-submodules-choice #f) @@ -652,6 +665,10 @@ (set! save-stacktrace-on-check-box (new check-box% [label (string-constant preserve-stacktrace-information)] [parent dynamic-panel])) + (set! enforce-module-constants-checkbox + (new check-box% + [label (string-constant enforce-module-constants-checkbox-label)] + [parent dynamic-panel])) (set! run-submodules-choice (new (class name-message% (define/override (fill-popup menu reset) @@ -841,7 +858,7 @@ (update-buttons) (install-auto-text (get-default-auto-text)) (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box) - + (case-lambda [() (let ([simple-settings (simple-case-lambda)]) @@ -855,7 +872,8 @@ [(0 1) compilation-on?] [(#f) #f]) (send save-stacktrace-on-check-box get-value) - submodules-to-run))))] + submodules-to-run + (send enforce-module-constants-checkbox get-value)))))] [(settings) (simple-case-lambda settings) (install-collection-paths (module-language-settings-collection-paths settings)) @@ -866,6 +884,7 @@ (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box) (send save-stacktrace-on-check-box set-value (module-language-settings-full-trace? settings)) (set! submodules-to-run (module-language-settings-submodules-to-run settings)) + (send enforce-module-constants-checkbox set-value (module-language-settings-enforce-module-constants settings)) (update-buttons)])) (define (add-another-possible-submodule parent) diff --git a/collects/scribblings/drracket/languages.scrbl b/collects/scribblings/drracket/languages.scrbl index 82155edd94..97338ce974 100644 --- a/collects/scribblings/drracket/languages.scrbl +++ b/collects/scribblings/drracket/languages.scrbl @@ -14,17 +14,17 @@ new languages can be added through DrRacket plug-ins. @section[#:tag "module"]{Language Declared in Source} -The @as-index{@drlang{Use the language declared in the source} mode} +The @as-index{@drlang{The Racket Language} mode} in DrRacket is a kind of meta-language, where the program itself specifies its language, usually through a @hash-lang[] line. -More generally, when using the declared-in-source mode, the +More generally, when using this mode, the @tech{definitions window} must contain a module in some form. Besides @hash-lang[], a Racket module can be written as @racket[(module -...)]. In any case, aside from comments, the @tech{definitions window} +...)]; aside from comments, the @tech{definitions window} must contain exactly one module. -In the details pane of the module language, some of the configuration +In the details pane of the language dialog, some of the configuration options correspond to using various libraries and thus can be used without DrRacket. Here's how, for the ones that are straightforward (the ones not mentioned here require more sophisticated configuration @@ -45,7 +45,7 @@ of various libraries). The @italic{Syntactic test suite coverage} option means to use @racket[test-coverage-enabled] in conjunction with @racket[current-eval]. - The other two checkboxes save compiled @tt{.zo} files and adjust the JIT compiler. + The other three checkboxes save compiled @tt{.zo} files and adjust the compiler. The @italic{populate compiled/ directories} option corresponds to @racketblock[(current-load/use-compiled @@ -62,6 +62,10 @@ of various libraries). The @italic{Preserve stacktrace} option corresponds to @racketblock[(compile-context-preservation-enabled #t)] + + The @italic{Enforce constant definitions (enables some inlining)} option + corresponds to calling @racket[compile-enforce-module-constants]; + checking it passes @racket[#t] and leaving it unchecked passes @racket[#f]. } @item{@bold{Output Syntax}: The output syntax options correspond to settings in the @racketmodname[racket/pretty] library and the @racketmodname[mzlib/pconvert] library.} diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt index ce19501fbe..a7bc57d31c 100644 --- a/collects/string-constants/private/english-string-constants.rkt +++ b/collects/string-constants/private/english-string-constants.rkt @@ -1160,6 +1160,7 @@ please adhere to these guidelines: (enforce-primitives-check-box-label "Disallow redefinition of initial bindings") (automatically-compile "Populate \"compiled\" directories (for faster loading)") (preserve-stacktrace-information "Preserve stacktrace (disable some optimizations)") + (enforce-module-constants-checkbox-label "Enforce constant definitions (enables some inlining)") (expression-level-stacktrace "Expression-level stacktrace") (function-level-stacktrace "Function-level stacktrace") (submodules-to-run "Submodules to Run") diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 1031ac4666..ff87e8e3d9 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -52,6 +52,19 @@ the settings above should match r5rs [defs-prefix "#lang racket\n"]) (check-top-of-repl) + + (test-setting + (lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #f)) + "enforce-module-constants -- #f" + "#lang racket/base\n(define x 1)\n" + #:interactions "(set! x 2)\n" + "> (set! x 2)") + (test-setting + (lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #t)) + "enforce-module-constants -- #t" + "#lang racket/base\n(define x 1)\n" + #:interactions "(set! x 2)\n" + #rx"cannot modify a constant") (prepare-for-test-expression) @@ -1101,7 +1114,8 @@ the settings above should match r5rs ;; `result'. `set-setting' is expected to click around ;; in the language dialog. ;; `setting-name' is used in the error message when the test fails. -(define (test-setting set-setting setting-name expression result) +(define (test-setting set-setting setting-name expression result + #:interactions [interactions-expr #f]) (set-language #f) (set-setting) (let ([f (test:get-active-top-level-window)]) @@ -1110,10 +1124,15 @@ the settings above should match r5rs (let* ([drs (test:get-active-top-level-window)] [interactions (send drs get-interactions-text)]) (clear-definitions drs) - (type-in-definitions drs expression) + (insert-in-definitions drs expression) (do-execute drs) + (when interactions + (insert-in-interactions drs interactions-expr) + (wait-for-computation drs)) (let* ([got (fetch-output/should-be-tested drs)]) - (unless (string=? result got) + (unless (if (regexp? result) + (regexp-match? result got) + (string=? result got)) (eprintf "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n" (language) setting-name expression result got)))))