From 88441b7b2402ee36b0a6b84fe4955c56ee0df1e5 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 6 Apr 2026 13:08:37 -0500 Subject: [PATCH] in the module language, drracket asks the #lang language what the default value of the annotations should be This is designed to allow the teaching languages to turn on test coverage by default --- .../drracket/private/in-irl-namespace.rkt | 1 + .../private/insulated-read-language.rkt | 3 +- .../drracket/private/language.rkt | 125 ++++++++++++------ .../drracket/private/module-language.rkt | 66 ++++++--- drracket-core-lib/drracket/private/rep.rkt | 30 +++-- drracket-core-lib/info.rkt | 4 +- .../scribblings/drracket/languages.scrbl | 4 + .../scribblings/tools/lang-tools.scrbl | 24 +++- .../drracket/private/drsig.rkt | 3 +- 9 files changed, 184 insertions(+), 76 deletions(-) diff --git a/drracket-core-lib/drracket/private/in-irl-namespace.rkt b/drracket-core-lib/drracket/private/in-irl-namespace.rkt index a3226645c..dbb8fcdcd 100644 --- a/drracket-core-lib/drracket/private/in-irl-namespace.rkt +++ b/drracket-core-lib/drracket/private/in-irl-namespace.rkt @@ -246,6 +246,7 @@ string?) string?)))))] [(documentation-language-family) (or/c #f string?)] + [(drracket:default-instrumentation) (or/c 'none 'debug 'debug/profile 'test-coverage)] [else (error 'key->contract "unknown key")])) diff --git a/drracket-core-lib/drracket/private/insulated-read-language.rkt b/drracket-core-lib/drracket/private/insulated-read-language.rkt index 732f429ba..ce5369cbc 100644 --- a/drracket-core-lib/drracket/private/insulated-read-language.rkt +++ b/drracket-core-lib/drracket/private/insulated-read-language.rkt @@ -47,7 +47,8 @@ Will not work with the definitions text surrogate interposition that 'drracket:quote-matches 'drracket:comment-delimiters 'drracket:define-popup - 'documentation-language-family)) + 'documentation-language-family + 'drracket:default-instrumentation)) (provide (contract-out diff --git a/drracket-core-lib/drracket/private/language.rkt b/drracket-core-lib/drracket/private/language.rkt index 6da2a0648..5e7671c59 100644 --- a/drracket-core-lib/drracket/private/language.rkt +++ b/drracket-core-lib/drracket/private/language.rkt @@ -203,10 +203,10 @@ repeating-decimal-e)) (boolean? (vector-ref printable 3)) (boolean? (vector-ref printable 4)) - (memq (vector-ref printable 5) '(none debug debug/profile test-coverage)) + (memq (vector-ref printable 5) '(none debug debug/profile test-coverage lang-default)) (apply make-simple-settings (vector->list printable)))) (define/public (default-settings) - (make-simple-settings #t 'print 'mixed-fraction-e #f #t 'debug)) + (make-simple-settings #t 'print 'mixed-fraction-e #f #t 'lang-default)) (define/public (default-settings? x) (equal? (simple-settings->vector x) (simple-settings->vector (default-settings)))) @@ -254,6 +254,7 @@ #:debugging-radio-box-callback [debugging-radio-box-callback void] #:include-print-mode? [include-print-mode? #t] #:keyboard-shortcuts? [keyboard-shortcuts? #f] + #:lang-default-debugging? [lang-default-debugging? #f] ;; called whenever any of the settings changed; used when the settings ;; are put into the preferences dialog (which doesn't have an explicit @@ -264,6 +265,7 @@ (define debugging-keystroke #\b) (define debugging-and-profiling-keystroke #\p) (define test-coverage-keystroke #\c) + (define default-debugging-keystroke #\i) (letrec ([parent (new vertical-panel% (parent _parent) (alignment '(center center)))] @@ -308,6 +310,7 @@ [debugging-left-callback (λ () (send debugging-right set-selection #f) + (send debugging-bottom set-selection #f) (debugging-radio-box-callback) (something-changed))] [debugging-right (new radio-box% @@ -326,6 +329,24 @@ [debugging-right-callback (λ () (send debugging-left set-selection #f) + (send debugging-bottom set-selection #f) + (debugging-radio-box-callback) + (something-changed))] + [debugging-bottom + (and lang-default-debugging? + (new radio-box% + [label #f] + [parent dynamic-panel] + [choices (list (add-menu-shortcut + (string-constant use-hash-langs-instrumentation) + (and keyboard-shortcuts? default-debugging-keystroke)))] + [callback + (λ (a b) + (debugging-bottom-callback))]))] + [debugging-bottom-callback + (λ () + (send debugging-left set-selection #f) + (send debugging-right set-selection #f) (debugging-radio-box-callback) (something-changed))] [output-style (make-object radio-box% @@ -357,7 +378,11 @@ (make-object check-box% (string-constant decimal-notation-for-rationals) output-panel (λ (_1 _2) (something-changed)))]) - (get-debugging-radio-box debugging-left debugging-right) + (cond + [(procedure-arity-includes? get-debugging-radio-box 3) + (get-debugging-radio-box debugging-left debugging-right debugging-bottom)] + [else + (get-debugging-radio-box debugging-left debugging-right)]) (dynamic-panel-extras dynamic-panel) (define shortcuts @@ -376,7 +401,11 @@ (list test-coverage-keystroke (λ () (send debugging-right set-selection 1) - (debugging-right-callback))))) + (debugging-right-callback))) + (list default-debugging-keystroke + (λ () + (send debugging-bottom set-selection 0) + (debugging-bottom-callback))))) (drracket:language-configuration:config-panel-with-keystrokes @@ -396,33 +425,40 @@ 'mixed-fraction-e) (send show-sharing get-value) (send insert-newlines get-value) - (case (send debugging-left get-selection) - [(0) 'none] - [(1) 'debug] - [(#f) - (case (send debugging-right get-selection) - [(0) 'debug/profile] - [(1) 'test-coverage])]))] + (match (send debugging-left get-selection) + [0 'none] + [1 'debug] + [#f + (match (send debugging-right get-selection) + [0 'debug/profile] + [1 'test-coverage] + [#f (cond + [debugging-bottom + (match (send debugging-bottom get-selection) + [0 'lang-default])] + [else #f])])]))] [(settings) (when case-sensitive (send case-sensitive set-value (simple-settings-case-sensitive settings))) (send output-style set-selection - (case (simple-settings-printing-style settings) - [(constructor) 0] - [(quasiquote) 1] - [(write trad-write) 2] - [(print) (if include-print-mode? 3 2)])) + (match (simple-settings-printing-style settings) + ['constructor 0] + ['quasiquote 1] + ['write 2] + ['trad-write 2] + ['print (if include-print-mode? 3 2)])) (enable-fraction-style) (send fraction-style set-value (eq? (simple-settings-fraction-style settings) 'repeating-decimal-e)) (send show-sharing set-value (simple-settings-show-sharing settings)) (send insert-newlines set-value (simple-settings-insert-newlines settings)) - (case (simple-settings-annotations settings) - [(none) (send debugging-right set-selection #f) (send debugging-left set-selection 0)] - [(debug) (send debugging-right set-selection #f) (send debugging-left set-selection 1)] - [(debug/profile) (send debugging-left set-selection #f) (send debugging-right set-selection 0)] - [(test-coverage) (send debugging-left set-selection #f) (send debugging-right set-selection 1)])]) + (match (simple-settings-annotations settings) + ['none (send debugging-right set-selection #f) (send debugging-left set-selection 0) (when debugging-bottom (send debugging-bottom set-selection #f))] + ['debug (send debugging-right set-selection #f) (send debugging-left set-selection 1) (when debugging-bottom (send debugging-bottom set-selection #f))] + ['debug/profile (send debugging-left set-selection #f) (send debugging-right set-selection 0) (when debugging-bottom (send debugging-bottom set-selection #f))] + ['test-coverage (send debugging-left set-selection #f) (send debugging-right set-selection 1) (when debugging-bottom (send debugging-bottom set-selection #f))] + ['lang-default (when debugging-bottom (send debugging-left set-selection #f) (send debugging-right set-selection #f) (send debugging-bottom set-selection 0))])]) (if keyboard-shortcuts? shortcuts '())))) ;; simple-module-based-language-render-value/format : TST settings port (union #f (snip% -> void)) (union 'infinity number) -> void @@ -645,33 +681,38 @@ (to-snip-value? expr)) expr (sh expr basic-convert sub-convert))) - + +(define lang-default-annotations (make-parameter 'debug)) + ;; initialize-simple-module-based-language : setting ((-> void) -> void) (define (initialize-simple-module-based-language setting run-in-user-thread) + (define annotations + (cond + [(equal? (simple-settings-annotations setting) 'lang-default) + (lang-default-annotations)] + [else (simple-settings-annotations setting)])) (run-in-user-thread (λ () - - (let ([annotations (simple-settings-annotations setting)]) - (case annotations - [(debug) - (current-compile (drracket:debug:make-debug-compile-handler (current-compile))) - (error-display-handler - (drracket:debug:make-debug-error-display-handler - (error-display-handler)))] + (case annotations + [(debug) + (current-compile (drracket:debug:make-debug-compile-handler (current-compile))) + (error-display-handler + (drracket:debug:make-debug-error-display-handler + (error-display-handler)))] - [(debug/profile) - (drracket:debug:profiling-enabled #t) - (error-display-handler - (drracket:debug:make-debug-error-display-handler - (error-display-handler))) - (current-eval (drracket:debug:make-debug-eval-handler (current-eval)))] + [(debug/profile) + (drracket:debug:profiling-enabled #t) + (error-display-handler + (drracket:debug:make-debug-error-display-handler + (error-display-handler))) + (current-eval (drracket:debug:make-debug-eval-handler (current-eval)))] - [(test-coverage) - (drracket:debug:test-coverage-enabled #t) - (error-display-handler - (drracket:debug:make-debug-error-display-handler - (error-display-handler))) - (current-eval (drracket:debug:make-debug-eval-handler (current-eval)))])) + [(test-coverage) + (drracket:debug:test-coverage-enabled #t) + (error-display-handler + (drracket:debug:make-debug-error-display-handler + (error-display-handler))) + (current-eval (drracket:debug:make-debug-eval-handler (current-eval)))]) (define-values (my-setup-printing-parameters drracket-pretty-print-size-hook diff --git a/drracket-core-lib/drracket/private/module-language.rkt b/drracket-core-lib/drracket/private/module-language.rkt index 5df4b7704..06a377eaa 100644 --- a/drracket-core-lib/drracket/private/module-language.rkt +++ b/drracket-core-lib/drracket/private/module-language.rkt @@ -229,7 +229,9 @@ [(debug/profile) (string-constant module-language-repl-debug/profile-annotations)] [(test-coverage) - (string-constant module-language-repl-test-annotations)]))] + (string-constant module-language-repl-test-annotations)] + [(lang-default) + (string-constant module-language-repl-no-annotations)]))] [else (get-language-name)])) @@ -256,12 +258,12 @@ ;; NOTE: this method is also used in the super class's implementation ;; of default-settings?, which is why the super call is appropriate ;; there, even tho these settings are not the same as the defaults - ;; in other languages (here 'none is the default annotations, + ;; in other languages (here 'lang-default is the default annotations, ;; there you get errortrace annotations). (define/override (default-settings) (let ([super-defaults (super default-settings)]) (make-module-language-settings - #t 'print 'mixed-fraction-e #f #t 'debug;; simple settings defaults + #t 'print 'mixed-fraction-e #f #t 'lang-default;; simple settings defaults '(default) #() @@ -273,8 +275,15 @@ ;; default-settings? : -> boolean (define/override (default-settings? settings) - - (and (super default-settings? settings) + + ;; first, check the simple settings defaults + (and (equal? (lmn:drracket:language:simple-settings-case-sensitive settings) #t) + (equal? (lmn:drracket:language:simple-settings-printing-style settings) 'print) + (equal? (lmn:drracket:language:simple-settings-fraction-style settings) 'mixed-fraction-e) + (equal? (lmn:drracket:language:simple-settings-show-sharing settings) #f) + (equal? (lmn:drracket:language:simple-settings-insert-newlines settings) #t) + ;; except we want a different default for annotations + (equal? (lmn:drracket:language:simple-settings-annotations settings) 'lang-default) (equal? (module-language-settings-collection-paths settings) '(default)) @@ -359,15 +368,21 @@ ;; versions might. (and (memq (drracket:language:simple-settings-annotations super) - '(none debug)) + '(none debug lang-default)) compilation-on?) full-trace? submodules-to-run enforce-module-constants))))))))))) - - (define/override (on-execute settings run-in-user-thread) - (super on-execute settings run-in-user-thread) + + ;; drracket will always supply `the-irl`, but some tools might call this, + ;; and they might not supply it + (define/override (on-execute settings run-in-user-thread [the-irl #f]) + (parameterize ([drracket:language:lang-default-annotations + (call-read-language the-irl + 'drracket:default-instrumentation + 'debug)]) + (super on-execute settings run-in-user-thread)) (let ([currently-open-files (get-currently-open-files)]) (run-in-user-thread @@ -691,6 +706,7 @@ (define run-submodules-choice #f) (define left-debugging-radio-box #f) (define right-debugging-radio-box #f) + (define bottom-debugging-radio-box #f) (define submodules-to-run #f) (define (set-submodules-to-run l) @@ -721,13 +737,15 @@ #:something-changed something-changed #:case-sensitive #t - #:get-debugging-radio-box (λ (rb-l rb-r) + #:get-debugging-radio-box (λ (rb-l rb-r rb-b) (set! left-debugging-radio-box rb-l) - (set! right-debugging-radio-box rb-r)) + (set! right-debugging-radio-box rb-r) + (set! bottom-debugging-radio-box rb-b)) #:debugging-radio-box-callback (λ () - (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)) + (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box)) + #:lang-default-debugging? #t #:dynamic-panel-extras (λ (dynamic-panel) @@ -783,12 +801,19 @@ [font normal-control-font] [parent dynamic-panel] [label (string-constant submodules-to-run)]))))))) - (define (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box) - (case (send left-debugging-radio-box get-selection) - [(0 1) + (define (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box) + (define compilation-on-allowed? + (match* ((send left-debugging-radio-box get-selection) + (send bottom-debugging-radio-box get-selection)) + [(0 _) #t] + [(1 _) #t] + [(_ 0) #t] + [(_ _) #f])) + (cond + [compilation-on-allowed? (send compilation-on-check-box enable #t) (send compilation-on-check-box set-value compilation-on?)] - [(#f) + [else (send compilation-on-check-box enable #f) (send compilation-on-check-box set-value #f)])) @@ -924,7 +949,7 @@ (install-collection-paths '(default)) (update-buttons) - (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box) + (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box) (define shortcuts (append @@ -954,7 +979,10 @@ #f ;; auto-text in the settings is ignored. (case (send left-debugging-radio-box get-selection) [(0 1) compilation-on?] - [(#f) #f]) + [(#f) + (case (send bottom-debugging-radio-box get-selection) + [(0) compilation-on?] + [else #f])]) (send save-stacktrace-on-check-box get-value) submodules-to-run (send enforce-module-constants-checkbox get-value)))))] @@ -964,7 +992,7 @@ (install-command-line-args (module-language-settings-command-line-args settings)) (set! compilation-on? (module-language-settings-compilation-on? settings)) (send compilation-on-check-box set-value (module-language-settings-compilation-on? settings)) - (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box) + (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-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 diff --git a/drracket-core-lib/drracket/private/rep.rkt b/drracket-core-lib/drracket/private/rep.rkt index 745077a66..5f704de89 100644 --- a/drracket-core-lib/drracket/private/rep.rkt +++ b/drracket-core-lib/drracket/private/rep.rkt @@ -1454,16 +1454,26 @@ TODO (send context set-breakables #f #f) ;; initialize the language - (send (drracket:language-configuration:language-settings-language user-language-settings) - on-execute - (drracket:language-configuration:language-settings-settings user-language-settings) - (let ([run-on-user-thread - (lambda (t) - (queue-user/wait - (λ () - (with-handlers ((exn? (λ (x) (oprintf "~s\n" (exn-message x))))) - (t)))))]) - run-on-user-thread)) + (let () + (define (run-on-user-thread t) + (queue-user/wait + (λ () + (with-handlers ((exn? (λ (x) (oprintf "~s\n" (exn-message x))))) + (t))))) + (define lang (drracket:language-configuration:language-settings-language user-language-settings)) + (define settings (drracket:language-configuration:language-settings-settings user-language-settings)) + (cond + [(is-a? lang drracket:module-language:module-language<%>) + (send lang + on-execute + settings + run-on-user-thread + (send definitions-text get-irl))] + [else + (send lang + on-execute + settings + run-on-user-thread)])) ;; setup the special repl values (let ([raised-exn? #f] diff --git a/drracket-core-lib/info.rkt b/drracket-core-lib/info.rkt index 6465d5135..c65b70a76 100644 --- a/drracket-core-lib/info.rkt +++ b/drracket-core-lib/info.rkt @@ -30,7 +30,7 @@ ["racket-index" #:version "1.4"] "sandbox-lib" ["scribble-lib" #:version "1.11"] - ["string-constants-lib" #:version "1.54"] + ["string-constants-lib" #:version "1.57"] ["syntax-color-lib" #:version "1.4"] "simple-tree-text-markup-lib" "typed-racket-lib" @@ -42,7 +42,7 @@ (define pkg-authors '(robby)) -(define version "1.16") +(define version "1.17") (define license '(Apache-2.0 OR MIT)) diff --git a/drracket-core/scribblings/drracket/languages.scrbl b/drracket-core/scribblings/drracket/languages.scrbl index 182a0f8e6..49c560535 100644 --- a/drracket-core/scribblings/drracket/languages.scrbl +++ b/drracket-core/scribblings/drracket/languages.scrbl @@ -76,6 +76,10 @@ of various libraries). The @italic{Syntactic test suite coverage} option means to use @racket[test-coverage-enabled] in conjunction with @racket[current-eval]. + The @italic{Use the #lang's default choice for instrumentation} option means to use one + of the previous options, as specified by @elemref["drracket:default-instrumentation"]{the + @racket['drracket:default-instrumentation] key} from @racket[read-language]. + The other three checkboxes save compiled @tt{.zo} files and adjust the compiler. The @italic{populate compiled/ directories} option corresponds to diff --git a/drracket-core/scribblings/tools/lang-tools.scrbl b/drracket-core/scribblings/tools/lang-tools.scrbl index bfc26f954..9476194b7 100644 --- a/drracket-core/scribblings/tools/lang-tools.scrbl +++ b/drracket-core/scribblings/tools/lang-tools.scrbl @@ -58,7 +58,8 @@ arguments. Other tools may use only a subset. @item{@language-info-ref[drracket:toolbar-buttons]} @item{@language-info-ref[drracket:define-popup]} @item{@language-info-ref[documentation-language-family]} - @item{@language-info-ref[definitions-text-surrogate]}] + @item{@language-info-ref[definitions-text-surrogate]} + @item{@language-info-ref[drracket:default-instrumentation]}] @section{Syntax Coloring} @@ -607,6 +608,27 @@ DrRacket uses the contents of this hash in three ways: }] } +@section[#:tag "sec:drracket:default-instrumentation"]{Defaulting to Debugging or other Errortrace-based Annotations} + +@language-info-def[drracket:default-instrumentation]{ +DrRacket uses the @racketmodname[errortrace] library to instrument programs +before evaluating them, resulting in a tradeoff between feedback to the +programmer and execution (and compile-time) cost. But default, each +@tt{#lang}-based language is run with errortrace's debugging annotations, +meaning that error context information is relatively fine-grained. For some +languages, however, this default isn't appropriate. By responding to the +key drracket:default-instrumentation, a language can choose a different +default. These are the options: +@itemlist[ + @item{@racket['none]: no errortrace-based annotations} + @item{@racket['debug]: instruments the program to provide fine-grained stacktrace information} + @item{@racket['debug/profile]: instruments the program to provide fine-grained stacktrace information and profiling information} + @item{@racket['test-coverage]: instruments the program to provide fine-grained stacktrace information and test coverage information} + ] + } + +@history[#:added "1.17"] + @section[#:tag "sec:definitions-text-surrogate"]{Definitions Text Surrogate} Using a @tt{#lang}-specific definitions text surrogate is a diff --git a/drracket-plugin-lib/drracket/private/drsig.rkt b/drracket-plugin-lib/drracket/private/drsig.rkt index f4afddf48..daa0c0a06 100644 --- a/drracket-plugin-lib/drracket/private/drsig.rkt +++ b/drracket-plugin-lib/drracket/private/drsig.rkt @@ -380,7 +380,8 @@ setup-setup-values simple-module-based-language-render-value/format add-menu-shortcut - mouse-event-uses-shortcut-prefix?)) + mouse-event-uses-shortcut-prefix? + lang-default-annotations)) (define-signature drracket:multi-file-search-cm^ ())