From 16c324e3af5ea1e2682ee4a2a4e8e9adf18a3d18 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 1/7] Fix 1 occurrence of `when-expression-in-for-loop-to-when-keyword` Use the `#:when` keyword instead of `when` to reduce loop body indentation. --- .../drracket/private/stack-checkpoint.rkt | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/drracket-core-lib/drracket/private/stack-checkpoint.rkt b/drracket-core-lib/drracket/private/stack-checkpoint.rkt index a511b7193..f852577a2 100644 --- a/drracket-core-lib/drracket/private/stack-checkpoint.rkt +++ b/drracket-core-lib/drracket/private/stack-checkpoint.rkt @@ -224,12 +224,12 @@ interesting-editor-editions) (define (add-editions-to-interesting-editors editions interesting-editor-editions) - (for ([edition (in-list editions)]) - (when edition - (match-define (cons wb edition-number) edition) - (define ed (weak-box-value wb)) - (when ed - (hash-set! interesting-editor-editions ed edition))))) + (for ([edition (in-list editions)] + #:when edition) + (match-define (cons wb edition-number) edition) + (define ed (weak-box-value wb)) + (when ed + (hash-set! interesting-editor-editions ed edition)))) (define (empty-viewable-stack? a-viewable-stack) (match-define (viewable-stack stack-items _ _ _ _) From c77405b68d031a051650ae220d373a31692282ff Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 2/7] Fix 1 occurrence of `cond-let-to-cond-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- .../drracket/private/eval-helpers-and-pref-init.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt b/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt index 4c85f627a..e60e2ccd4 100644 --- a/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt +++ b/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt @@ -37,8 +37,8 @@ (define (get-init-dir path/f) (cond [path/f - (let-values ([(base name dir?) (split-path path/f)]) - base)] + (define-values (base name dir?) (split-path path/f)) + base] [else (find-system-path 'home-dir)])) From 232e8473f3e9856226f6b872338b12cd56627941 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 3/7] Fix 2 occurrences of `define-let-to-double-define` This `let` expression can be pulled up into a `define` expression. --- drracket-core-lib/drracket/private/debug.rkt | 16 ++++++++-------- .../private/eval-helpers-and-pref-init.rkt | 8 ++++---- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/drracket-core-lib/drracket/private/debug.rkt b/drracket-core-lib/drracket/private/debug.rkt index 6fbb2846d..6ab2dd3b5 100644 --- a/drracket-core-lib/drracket/private/debug.rkt +++ b/drracket-core-lib/drracket/private/debug.rkt @@ -591,15 +591,15 @@ (display name (current-error-port))])) (define (do-line/col) (eprintf ":~a:~a" line col)) (define (do-pos) (eprintf "::~a" pos)) + (define rep (drracket:rep:current-rep)) (define src-loc-in-defs/ints? - (let ([rep (drracket:rep:current-rep)]) - (and rep - (is-a? rep drracket:rep:text<%>) - (let ([defs (send rep get-definitions-text)]) - (or (send rep port-name-matches? src) - (eq? rep src) - (send defs port-name-matches? src) - (eq? defs src)))))) + (and rep + (is-a? rep drracket:rep:text<%>) + (let ([defs (send rep get-definitions-text)]) + (or (send rep port-name-matches? src) + (eq? rep src) + (send defs port-name-matches? src) + (eq? defs src))))) (cond [(and src line col) (do-icon) diff --git a/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt b/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt index e60e2ccd4..7f34d392a 100644 --- a/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt +++ b/drracket-core-lib/drracket/private/eval-helpers-and-pref-init.rkt @@ -128,11 +128,11 @@ (if sd (list sd) null))]) (λ (p) (define skip-in-paths? (file-stamp-in-paths p no-dirs)) + (define pkg (path->pkg p #:cache path->pkg-cache)) (define skip-pkgs? - (let ([pkg (path->pkg p #:cache path->pkg-cache)]) - (and pkg - (not (set-member? open-pkgs pkg)) - (file-stamp-in-paths p (list (pkg-directory/use-cache pkg)))))) + (and pkg + (not (set-member? open-pkgs pkg)) + (file-stamp-in-paths p (list (pkg-directory/use-cache pkg))))) (log-drracket/cm-info "~a; skip? ~a ~a thd ~a" p (and skip-in-paths? #t) From d0ae94e179337649930c28716b4b035e4ad3f8ac Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 4/7] Fix 2 occurrences of `list-element-definitions-to-match-define` These list element variable definitions can be expressed more succinctly with `match-define`. Note that the suggested replacement raises an error if the list contains more elements than expected. --- drracket-core-lib/drracket/private/debug.rkt | 6 ++---- .../drracket/private/standalone-module-browser.rkt | 6 ++---- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/drracket-core-lib/drracket/private/debug.rkt b/drracket-core-lib/drracket/private/debug.rkt index 6ab2dd3b5..c10d36a2b 100644 --- a/drracket-core-lib/drracket/private/debug.rkt +++ b/drracket-core-lib/drracket/private/debug.rkt @@ -408,11 +408,9 @@ [i (in-naturals)]) (unless (zero? i) (newline (current-error-port))) (cond - [(string? x) - (display x (current-error-port))] + [(string? x) (display x (current-error-port))] [(pair? x) - (define line (list-ref x 0)) - (define to-show-later (list-ref x 1)) + (match-define (list line to-show-later) x) (write-string line (current-error-port) 0 (- (string-length line) 4)) (write-special (new ellipsis-snip% [extra to-show-later]) (current-error-port)) (display ":" (current-error-port))]))) diff --git a/drracket-tool-lib/drracket/private/standalone-module-browser.rkt b/drracket-tool-lib/drracket/private/standalone-module-browser.rkt index 78cd6299e..17a12f25d 100644 --- a/drracket-tool-lib/drracket/private/standalone-module-browser.rkt +++ b/drracket-tool-lib/drracket/private/standalone-module-browser.rkt @@ -1392,13 +1392,11 @@ (case key [(done) (semaphore-post val)] [(died) (exit)] - [(progress) + [(progress) (show-status val) (loop)] [(connect) - (define name-original (list-ref val 0)) - (define path-key (list-ref val 1)) - (define require-depth (list-ref val 2)) + (match-define (list name-original path-key require-depth) val) (send pasteboard add-connection name-original path-key require-depth) (loop)]))) (send pasteboard end-adding-connections) From aeea8f9172ba652688fade883148113b7174943e Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 5/7] Fix 12 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- drracket-core-lib/drracket/private/debug.rkt | 297 +++++++++---------- 1 file changed, 143 insertions(+), 154 deletions(-) diff --git a/drracket-core-lib/drracket/private/debug.rkt b/drracket-core-lib/drracket/private/debug.rkt index c10d36a2b..f04305650 100644 --- a/drracket-core-lib/drracket/private/debug.rkt +++ b/drracket-core-lib/drracket/private/debug.rkt @@ -112,14 +112,14 @@ (define/override (draw dc x y left top right bottom dx dy draw-caret) (super draw dc x y left top right bottom dx dy draw-caret) (when (and in-bounds? grabbed?) - (let ([brush (send dc get-brush)] - [pen (send dc get-pen)]) - (let-values ([(w h) (get-w/h dc)]) - (send dc set-brush (send the-brush-list find-or-create-brush "black" 'hilite)) - (send dc set-pen (send the-pen-list find-or-create-pen "white" 1 'transparent)) - (send dc draw-rectangle x y w h) - (send dc set-pen pen) - (send dc set-brush brush))))) + (define brush (send dc get-brush)) + (define pen (send dc get-pen)) + (define-values (w h) (get-w/h dc)) + (send dc set-brush (send the-brush-list find-or-create-brush "black" 'hilite)) + (send dc set-pen (send the-pen-list find-or-create-pen "white" 1 'transparent)) + (send dc draw-rectangle x y w h) + (send dc set-pen pen) + (send dc set-brush brush))) (define/override (on-event dc x y editorx editory evt) (define-values (w h) (get-w/h dc)) @@ -139,19 +139,18 @@ (set-clicked grabbed? in-bounds? dc)])) (define/private (invalidate dc) - (let ([admin (get-admin)]) - (when admin - (let-values ([(w h) (get-w/h dc)]) - (send admin needs-update this 0 0 w h))))) + (define admin (get-admin)) + (when admin + (let-values ([(w h) (get-w/h dc)]) + (send admin needs-update this 0 0 w h)))) (define/private (get-w/h dc) - (let ([wb (box 0)] - [hb (box 0)]) - ;; know that the snip is the same size everywhere, - ;; so just use (0,0) for its position - (get-extent dc 0 0 wb hb #f #f #f #f) - (values (unbox wb) - (unbox hb)))) + (define wb (box 0)) + (define hb (box 0)) + ;; know that the snip is the same size everywhere, + ;; so just use (0,0) for its position + (get-extent dc 0 0 wb hb #f #f #f #f) + (values (unbox wb) (unbox hb))) (define/override (adjust-cursor dc x y editorx editory event) arrow-cursor) @@ -188,9 +187,9 @@ (inherit get-callback set-callback) (init-field str) (define/override (copy) - (let ([n (new clickable-string-snip% [str str])]) - (send n set-callback (get-callback)) - n)) + (define n (new clickable-string-snip% [str str])) + (send n set-callback (get-callback)) + n) (define/override (write f) (define bts (string->bytes/utf-8 str)) (send f put (bytes-length bts) bts)) @@ -228,12 +227,12 @@ (define/public (set-srclocs s) (set! srclocs s)) (define/public (get-srclocs) srclocs) - (define/override (copy) - (let ([n (new note%)]) - (send n set-callback (get-callback)) - (send n set-stacks stack1 stack2) - (send n set-srclocs srclocs) - n)) + (define/override (copy) + (define n (new note%)) + (send n set-callback (get-callback)) + (send n set-stacks stack1 stack2) + (send n set-srclocs srclocs) + n) (super-make-object bitmap))]) note%))) @@ -248,10 +247,10 @@ (define install-note% (class clickable-image-snip% (inherit get-callback) - (define/override (copy) - (let ([n (new install-note%)]) - (send n set-callback (get-callback)) - n)) + (define/override (copy) + (define n (new install-note%)) + (send n set-callback (get-callback)) + n) (super-new))) ;; display-stats : (syntax -> syntax) @@ -277,43 +276,38 @@ ;; make-debug-eval-handler : (sexp -> value) -> sexp -> value ;; adds debugging information to `sexp' and calls `oe' (define (make-debug-eval-handler oe) - (let ([debug-tool-eval-handler - (λ (orig-exp) - (if (compiled-expression? (if (syntax? orig-exp) - (syntax-e orig-exp) - orig-exp)) - (oe orig-exp) - (let loop ([exp (if (syntax? orig-exp) - orig-exp - (namespace-syntax-introduce - (datum->syntax #f orig-exp)))]) - (let ([top-e (expand-syntax-to-top-form exp)]) - (syntax-case top-e (begin) - [(begin expr ...) - ;; Found a `begin', so expand/eval each contained - ;; expression one at a time - (let i-loop ([exprs (syntax->list #'(expr ...))] - [last-one (list (void))]) - (cond - [(null? exprs) - (apply values last-one)] - [else - (i-loop (cdr exprs) - (call-with-values - (λ () - (call-with-continuation-prompt - (λ () (loop (car exprs))) - (default-continuation-prompt-tag) - (λ args - (apply - abort-current-continuation - (default-continuation-prompt-tag) - args)))) - list))]))] - [_else - ;; Not `begin', so proceed with normal expand and eval - (oe (errortrace-annotate top-e #f))])))))]) - debug-tool-eval-handler)) + (define (debug-tool-eval-handler orig-exp) + (if (compiled-expression? (if (syntax? orig-exp) + (syntax-e orig-exp) + orig-exp)) + (oe orig-exp) + (let loop ([exp (if (syntax? orig-exp) + orig-exp + (namespace-syntax-introduce (datum->syntax #f orig-exp)))]) + (let ([top-e (expand-syntax-to-top-form exp)]) + (syntax-case top-e (begin) + [(begin + expr ...) + ;; Found a `begin', so expand/eval each contained + ;; expression one at a time + (let i-loop ([exprs (syntax->list #'(expr ...))] + [last-one (list (void))]) + (cond + [(null? exprs) (apply values last-one)] + [else + (i-loop (cdr exprs) + (call-with-values (λ () + (call-with-continuation-prompt + (λ () (loop (car exprs))) + (default-continuation-prompt-tag) + (λ args + (apply abort-current-continuation + (default-continuation-prompt-tag) + args)))) + list))]))] + ;; Not `begin', so proceed with normal expand and eval + [_else (oe (errortrace-annotate top-e #f))]))))) + debug-tool-eval-handler) (define (make-debug-compile-handler orig) (make-debug-compile-handler/errortrace-annotate orig errortrace-annotate)) @@ -332,12 +326,10 @@ (printf " ~s\n" e))) exn) (λ () - (let ([rep (drracket:rep:current-rep)]) - (cond - [rep - (error-display-handler/stacktrace msg exn)] - [else - (orig-error-display-handler msg exn)]))))) + (define rep (drracket:rep:current-rep)) + (cond + [rep (error-display-handler/stacktrace msg exn)] + [else (orig-error-display-handler msg exn)])))) debug-error-display-handler) ;; error-display-handler/stacktrace : string any (or/c #f viewable-stack? (listof srcloc)) -> void @@ -435,24 +427,21 @@ ;; =User= (define (print-planet-icon-to-stderr exn) (when (exn:fail:contract:blame? exn) - (let ([table (parse-gp exn - (blame-positive - (exn:fail:contract:blame-object exn)))]) - (when table - (let ([gp-url (bug-info->ticket-url table)]) - (when planet-note% - (when (port-writes-special? (current-error-port)) - (let ([note (new planet-note%)]) - (send note set-callback (λ (snp) - ;; =Kernel= =Handler= - (drracket:unit:forget-saved-bug-report table) - (send-url (url->string gp-url)))) - (parameterize ([current-eventspace drracket:init:system-eventspace]) - (queue-callback - (λ () - (drracket:unit:record-saved-bug-report table)))) - (write-special note (current-error-port)) - (display #\space (current-error-port)))))))))) + (define table (parse-gp exn (blame-positive (exn:fail:contract:blame-object exn)))) + (when table + (let ([gp-url (bug-info->ticket-url table)]) + (when planet-note% + (when (port-writes-special? (current-error-port)) + (let ([note (new planet-note%)]) + (send note set-callback + (λ (snp) + ;; =Kernel= =Handler= + (drracket:unit:forget-saved-bug-report table) + (send-url (url->string gp-url)))) + (parameterize ([current-eventspace drracket:init:system-eventspace]) + (queue-callback (λ () (drracket:unit:record-saved-bug-report table)))) + (write-special note (current-error-port)) + (display #\space (current-error-port))))))))) ;; =Kernel= =User= @@ -529,10 +518,10 @@ ;; =User= (define (exn->trace exn) - (let ([sp (open-output-string)]) - (parameterize ([current-error-port sp]) - (drracket:init:original-error-display-handler (exn-message exn) exn)) - (get-output-string sp))) + (define sp (open-output-string)) + (parameterize ([current-error-port sp]) + (drracket:init:original-error-display-handler (exn-message exn) exn)) + (get-output-string sp)) ;; =User= (define (print-bug-to-stderr msg viewable-stack1 viewable-stack2) @@ -635,69 +624,69 @@ ;; show-syntax-error-context : ;; display the source information associated with a syntax error (if present) (define (show-syntax-error-context port exn) - (let ([error-text-style-delta (make-object style-delta%)] - [send-out - (λ (msg f) - (if (port-writes-special? (current-error-port)) - (let loop ([msg msg]) - (cond - [(equal? msg "") (void)] - [(regexp-match-positions #rx"\n" msg) - => (lambda (m) - (loop (substring msg 0 (caar m))) - (display "\n " (current-error-port)) - (loop (substring msg (cdar m))))] - [else - (define snp (make-object string-snip% msg)) - (f snp) - (write-special snp (current-error-port))])) - (display msg (current-error-port))))]) - (send error-text-style-delta set-delta-foreground (make-object color% 200 0 0)) - (define (show-one str) - (display " " (current-error-port)) - (send-out str - (λ (snp) - (send snp set-style - (send (editor:get-standard-style-list) find-or-create-style - (send (editor:get-standard-style-list) find-named-style "Standard") - error-text-style-delta))))) - (define exprs (exn:fail:syntax-exprs exn)) - (define strs (for/list ([expr (in-list exprs)]) - ((error-syntax->string-handler) expr #f))) - (define (show-in) - (send-out " in:" - (λ (snp) - (send snp set-style - (send (editor:get-standard-style-list) find-named-style - (editor:get-default-color-style-name)))))) - (cond - [(null? strs) (void)] - [(and (null? (cdr strs)) - (not (regexp-match? #rx"\n" (car strs)))) - (show-in) - (show-one (car strs))] - [else - (show-in) - (for-each (λ (str) - (display "\n " (current-error-port)) - (show-one str)) - strs)]))) + (define error-text-style-delta (make-object style-delta%)) + (define (send-out msg f) + (if (port-writes-special? (current-error-port)) + (let loop ([msg msg]) + (cond + [(equal? msg "") (void)] + [(regexp-match-positions #rx"\n" msg) + => + (lambda (m) + (loop (substring msg 0 (caar m))) + (display "\n " (current-error-port)) + (loop (substring msg (cdar m))))] + [else + (define snp (make-object string-snip% msg)) + (f snp) + (write-special snp (current-error-port))])) + (display msg (current-error-port)))) + (send error-text-style-delta set-delta-foreground (make-object color% 200 0 0)) + (define (show-one str) + (display " " (current-error-port)) + (send-out str + (λ (snp) + (send snp set-style + (send (editor:get-standard-style-list) find-or-create-style + (send (editor:get-standard-style-list) find-named-style "Standard") + error-text-style-delta))))) + (define exprs (exn:fail:syntax-exprs exn)) + (define strs + (for/list ([expr (in-list exprs)]) + ((error-syntax->string-handler) expr #f))) + (define (show-in) + (send-out " in:" + (λ (snp) + (send snp set-style + (send (editor:get-standard-style-list) find-named-style + (editor:get-default-color-style-name)))))) + (cond + [(null? strs) (void)] + [(and (null? (cdr strs)) (not (regexp-match? #rx"\n" (car strs)))) + (show-in) + (show-one (car strs))] + [else + (show-in) + (for-each (λ (str) + (display "\n " (current-error-port)) + (show-one str)) + strs)])) ;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void) ;; inserts `note' and a space at the end of `rep' ;; also sets a clickback on the inserted `note' (but not the space). (define (insert/clickback rep note clickback) - (let ([before (send rep last-position)]) - (send rep insert (if (string? note) - note - (send note copy)) - before before) - (let ([after (send rep last-position)]) - (send rep insert #\space after after) - (send rep set-clickback before after - (λ (txt start end) - (clickback)))))) + (define before (send rep last-position)) + (send rep insert + (if (string? note) + note + (send note copy)) + before + before) + (define after (send rep last-position)) + (send rep insert #\space after after) + (send rep set-clickback before after (λ (txt start end) (clickback)))) ;; Note that this is not necessarily the same format used by `make-st-mark` ;; which is unspecified. From a5ed42ad60094ae6b867b2562931ba6b1da09fdb Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 6/7] Fix 1 occurrence of `quasiquote-to-list` This quasiquotation is equialent to a simple `list` call. --- drracket-core-lib/drracket/private/debug.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/drracket-core-lib/drracket/private/debug.rkt b/drracket-core-lib/drracket/private/debug.rkt index f04305650..58bc1625f 100644 --- a/drracket-core-lib/drracket/private/debug.rkt +++ b/drracket-core-lib/drracket/private/debug.rkt @@ -470,7 +470,7 @@ [(null? (cdr planet-version)) (format "~s" `(,(car planet-version) ?))] [else - (format "~s" `(,(car planet-version) ,(cadr planet-version)))])) + (format "~s" (list (car planet-version) (cadr planet-version)))])) (cons 'description (exn->trace exn)))] [else #f])) From c00d61c765cf37831e132f86df75834e5251d1ae Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 19 Oct 2025 00:20:09 +0000 Subject: [PATCH 7/7] Fix 1 occurrence of `nested-when-to-compound-when` Nested `when` expressions can be merged into a single compound `when` expression. --- drracket-core-lib/drracket/private/debug.rkt | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/drracket-core-lib/drracket/private/debug.rkt b/drracket-core-lib/drracket/private/debug.rkt index 58bc1625f..b7ccd9bbc 100644 --- a/drracket-core-lib/drracket/private/debug.rkt +++ b/drracket-core-lib/drracket/private/debug.rkt @@ -553,14 +553,13 @@ (define src-to-display (car srcs-to-display)) (match-define (srcloc src line col pos _span) src-to-display) (define (do-icon) - (when file-note% - (when (port-writes-special? (current-error-port)) - (define note (new file-note%)) - (send note set-srclocs srcs-to-display) - (send note set-callback - (λ (snp) (open-and-highlight-in-file srcs-to-display a-viewable-stack))) - (write-special note (current-error-port)) - (display #\space (current-error-port))))) + (when (and file-note% (port-writes-special? (current-error-port))) + (define note (new file-note%)) + (send note set-srclocs srcs-to-display) + (send note set-callback + (λ (snp) (open-and-highlight-in-file srcs-to-display a-viewable-stack))) + (write-special note (current-error-port)) + (display #\space (current-error-port)))) (define (do-src) (cond [(path? src)