add GUI support for compile-enforce-module-constants to DrRacket

closes PR 13781

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)])

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)

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.}

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")

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)))))