From 4101d8cdc5dc0373eee6c92bfe288f047f7be26b Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 1/6] Fix 4 occurrences of `nested-for-to-for*` These nested `for` loops can be replaced by a single `for*` loop. --- .../private/syncheck/contract-traversal.rkt | 20 +++++--- .../drracket/private/syncheck/traversals.rkt | 51 +++++++++---------- 2 files changed, 37 insertions(+), 34 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt b/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt index 3fe3db832..8967afdc0 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt @@ -29,14 +29,18 @@ [_ (void)])) ;; fill in the coloring-plans table for boundary contracts - (for ([(start-k start-val) (in-hash boundary-start-map)]) - (for ([start-stx (in-list start-val)]) - (do-contract-traversal start-stx #t - coloring-plans already-jumped-ids - low-binders binding-inits - domain-map range-map - #t - binder+mods-binder))) + (for* ([(start-k start-val) (in-hash boundary-start-map)] + [start-stx (in-list start-val)]) + (do-contract-traversal start-stx + #t + coloring-plans + already-jumped-ids + low-binders + binding-inits + domain-map + range-map + #t + binder+mods-binder)) ;; fill in the coloring-plans table for internal contracts (for ([(start-k start-val) (in-hash internal-start-map)]) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index 2ae2e8cf1..22e6163b5 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -798,13 +798,13 @@ (for ([k (in-hash-keys requires)]) (hash-set! new-hash k #t))) - (for ([(level binders) (in-hash phase-to-binders)]) - (for ([(_ binder+modss) (in-dict binders)]) - (for ([binder+mods (in-list binder+modss)]) - (define var (binder+mods-binder binder+mods)) - (define varset (lookup-phase-to-mapping phase-to-varsets level)) - (color-variable var level varset) - (document-variable var level)))) + (for* ([(level binders) (in-hash phase-to-binders)] + [(_ binder+modss) (in-dict binders)] + [binder+mods (in-list binder+modss)]) + (define var (binder+mods-binder binder+mods)) + (define varset (lookup-phase-to-mapping phase-to-varsets level)) + (color-variable var level varset) + (document-variable var level)) (for ([(level+mods varrefs) (in-hash phase-to-varrefs)]) (define level (list-ref level+mods 0)) @@ -812,21 +812,21 @@ (define binders (lookup-phase-to-mapping phase-to-binders level)) (define varsets (lookup-phase-to-mapping phase-to-varsets level)) (initialize-binder-connections binders connections) - (for ([vars (in-list (get-idss varrefs))]) - (for ([var (in-list vars)]) - (color-variable var level varsets) - (document-variable var level) - (connect-identifier var - mods - binders - unused/phases - phase-to-requires - level - user-namespace - user-directory - #t - connections - module-lang-requires)))) + (for* ([vars (in-list (get-idss varrefs))] + [var (in-list vars)]) + (color-variable var level varsets) + (document-variable var level) + (connect-identifier var + mods + binders + unused/phases + phase-to-requires + level + user-namespace + user-directory + #t + connections + module-lang-requires))) ;; build a set of all of the known phases @@ -862,10 +862,9 @@ (for ([(level tops) (in-hash phase-to-tops)]) (define binders (lookup-phase-to-mapping phase-to-binders level)) - (for ([vars (in-list (get-idss tops))]) - (for ([var (in-list vars)]) - (color/connect-top user-namespace user-directory binders var connections - module-lang-requires)))) + (for* ([vars (in-list (get-idss tops))] + [var (in-list vars)]) + (color/connect-top user-namespace user-directory binders var connections module-lang-requires))) (for ([(phase+mods require-hash) (in-hash phase-to-requires)]) ;; don't mark for-label requires as unused until we can properly handle them From 93939c10f25becedc957eedef982ad09aadab764 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 2/6] Fix 3 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/private/syncheck/traversals.rkt | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index 22e6163b5..c450bd951 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -807,8 +807,7 @@ (document-variable var level)) (for ([(level+mods varrefs) (in-hash phase-to-varrefs)]) - (define level (list-ref level+mods 0)) - (define mods (list-ref level+mods 1)) + (match-define (list level mods) level+mods) (define binders (lookup-phase-to-mapping phase-to-binders level)) (define varsets (lookup-phase-to-mapping phase-to-varsets level)) (initialize-binder-connections binders connections) @@ -835,8 +834,7 @@ (for ([phase (in-hash-keys phase-to-binders)]) (set! phases (set-add phases phase))) (for ([(phase+mod _) (in-hash phase-to-requires)]) - (define phase (list-ref phase+mod 0)) - (define mod (list-ref phase+mod 1)) + (match-define (list phase mod) phase+mod) (set! phases (set-add phases phase)) (set! all-mods (set-add all-mods mod))) @@ -873,8 +871,7 @@ (color-unused require-hash unused-hash module-lang-requires))) (for ([(level+mods directives) (in-hash sub-identifier-binding-directives)]) - (define phase-level (list-ref level+mods 0)) - (define mods (list-ref level+mods 1)) + (match-define (list phase-level mods) level+mods) (for ([directive (in-list directives)]) (match-define (vector binding-id to-start to-span to-dx to-dy new-binding-id from-start from-span from-dx from-dy) From b63cb1ecb07312bcbc98e9db5d162be28775b15e Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 3/6] Fix 10 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- .../drracket/private/syncheck/annotate.rkt | 16 +- .../drracket/private/syncheck/traversals.rkt | 166 +++++++++--------- 2 files changed, 86 insertions(+), 96 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt b/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt index a1d88c470..6c51cb2c5 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt @@ -11,12 +11,11 @@ ;; color : syntax[original] str -> void ;; colors the syntax with style-name's style (define (color stx style-name) - (let ([source (find-source-editor stx)]) - (when (and (syntax-position stx) - (syntax-span stx)) - (let ([pos (- (syntax-position stx) 1)] - [span (syntax-span stx)]) - (color-range source pos (+ pos span) style-name))))) + (define source (find-source-editor stx)) + (when (and (syntax-position stx) (syntax-span stx)) + (let ([pos (- (syntax-position stx) 1)] + [span (syntax-span stx)]) + (color-range source pos (+ pos span) style-name)))) ;; color-range : text start finish style-name ;; colors a range in the text based on `style-name' @@ -55,9 +54,8 @@ ;; find-source-editor : stx -> editor or false (define (find-source-editor stx) - (let ([defs-text (current-annotations)]) - (and defs-text - (find-source-editor/defs stx defs-text)))) + (define defs-text (current-annotations)) + (and defs-text (find-source-editor/defs stx defs-text))) ;; find-source-editor : stx text -> editor or false (define (find-source-editor/defs stx defs-text) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index c450bd951..4a513a2aa 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -944,8 +944,8 @@ (color-range source start end unused-require-style-name)) (define (self-module? mpi) - (let-values ([(a b) (module-path-index-split mpi)]) - (and (not a) (not b)))) + (define-values (a b) (module-path-index-split mpi)) + (and (not a) (not b))) ;; connect-identifier : syntax ;; (or/c #f (listof symbol)) -- name of enclosing sub-modules @@ -1134,22 +1134,29 @@ [else #f]))) ;; color/connect-top : namespace directory id-set syntax connections[see defn for ctc] -> void -(define (color/connect-top user-namespace user-directory binders var connections - module-lang-requires) - (let ([top-bound? - (or (get-ids binders var) - (parameterize ([current-namespace user-namespace]) - (let/ec k - (namespace-variable-value (syntax-e var) #t (λ () (k #f))) - #t)))]) - (cond - [top-bound? - (color var lexically-bound-variable-style-name)] - [else - (add-mouse-over var (format "~s is a free variable" (syntax-e var))) - (color var free-variable-style-name)]) - (connect-identifier var #f binders #f #f 0 user-namespace user-directory #t connections - module-lang-requires))) +(define (color/connect-top user-namespace user-directory binders var connections module-lang-requires) + (define top-bound? + (or (get-ids binders var) + (parameterize ([current-namespace user-namespace]) + (let/ec k + (namespace-variable-value (syntax-e var) #t (λ () (k #f))) + #t)))) + (cond + [top-bound? (color var lexically-bound-variable-style-name)] + [else + (add-mouse-over var (format "~s is a free variable" (syntax-e var))) + (color var free-variable-style-name)]) + (connect-identifier var + #f + binders + #f + #f + 0 + user-namespace + user-directory + #t + connections + module-lang-requires)) ;; annotate-counts : connections[see defn] -> void ;; this function doesn't try to show the number of uses at @@ -1313,22 +1320,19 @@ ;; popup menu in this area allows the programmer to jump ;; to the definition of the id. (define (add-jump-to-definition stx id filename submods phase-level+space) - (let ([source (find-source-editor stx)] - [defs-text (current-annotations)]) - (when (and source - defs-text - (syntax-position stx) - (syntax-span stx)) - (let* ([pos-left (- (syntax-position stx) 1)] - [pos-right (+ pos-left (syntax-span stx))]) - (send defs-text syncheck:add-jump-to-definition/phase-level+space - source - pos-left - pos-right - id - filename - submods - phase-level+space))))) + (define source (find-source-editor stx)) + (define defs-text (current-annotations)) + (when (and source defs-text (syntax-position stx) (syntax-span stx)) + (let* ([pos-left (- (syntax-position stx) 1)] + [pos-right (+ pos-left (syntax-span stx))]) + (send defs-text syncheck:add-jump-to-definition/phase-level+space + source + pos-left + pos-right + id + filename + submods + phase-level+space)))) ;; annotate-require-open : namespace string -> (stx -> void) ;; relies on current-module-name-resolver, which in turn depends on @@ -1404,10 +1408,10 @@ (unless (and (len . >= . 4) (bytes=? #".rkt" (subbytes bts (- len 4)))) (k rkt-path/f)) - (let ([ss-path (bytes->path (bytes-append (subbytes bts 0 (- len 4)) #".ss"))]) - (unless (file-exists? ss-path) - (k rkt-path/f)) - ss-path)))) + (define ss-path (bytes->path (bytes-append (subbytes bts 0 (- len 4)) #".ss"))) + (unless (file-exists? ss-path) + (k rkt-path/f)) + ss-path))) (values cleaned-up-path rkt-submods))) ;; add-origins : syntax? id-set exact-integer? -> void @@ -1466,20 +1470,21 @@ (add-init-exp binding-to-init stx init-exp level-of-enclosing-module)) (add-id id-set stx level-of-enclosing-module #:mods mods)) (let loop ([stx stx]) - (let ([e (if (syntax? stx) (syntax-e stx) stx)]) - (cond - [(cons? e) - (define fst (car e)) - (define rst (cdr e)) - (cond - [(syntax? fst) - (add-id&init&sub-range-binders fst) - (loop rst)] - [else - (loop rst)])] - [(null? e) (void)] - [else - (add-id&init&sub-range-binders stx)])))) + (define e + (if (syntax? stx) + (syntax-e stx) + stx)) + (cond + [(cons? e) + (define fst (car e)) + (define rst (cdr e)) + (cond + [(syntax? fst) + (add-id&init&sub-range-binders fst) + (loop rst)] + [else (loop rst)])] + [(null? e) (void)] + [else (add-id&init&sub-range-binders stx)]))) ;; add-definition-target : syntax[(sequence of identifiers)] (listof symbol) -> void (define (add-definition-target stx mods phase-level) @@ -1488,31 +1493,27 @@ (for ([id (in-list (if (list? stx) stx (syntax->list stx)))]) (define source (syntax-source id)) (define ib (identifier-binding id phase-level)) - (when (and (list? ib) - source - defs-text - (syntax-position id) - (syntax-span id)) - (let* ([pos-left (- (syntax-position id) 1)] - [pos-right (+ pos-left (syntax-span id))]) - (send defs-text syncheck:add-definition-target/phase-level+space - source - pos-left - pos-right - (list-ref ib 1) - (map submodule-name mods) - phase-level)))))) + (when (and (list? ib) source defs-text (syntax-position id) (syntax-span id)) + (define pos-left (- (syntax-position id) 1)) + (define pos-right (+ pos-left (syntax-span id))) + (send defs-text syncheck:add-definition-target/phase-level+space + source + pos-left + pos-right + (list-ref ib 1) + (map submodule-name mods) + phase-level))))) ;; annotate-raw-keyword : syntax id-map integer -> void ;; annotates keywords when they were never expanded. eg. ;; if someone just types `(λ (x) x)' it has no 'origin ;; field, but there still are keywords. (define (annotate-raw-keyword stx id-map level-of-enclosing-module) - (let ([lst (syntax-e stx)]) - (when (pair? lst) - (let ([f-stx (car lst)]) - (when (identifier? f-stx) - (add-id id-map f-stx level-of-enclosing-module)))))) + (define lst (syntax-e stx)) + (when (pair? lst) + (let ([f-stx (car lst)]) + (when (identifier? f-stx) + (add-id id-map f-stx level-of-enclosing-module))))) ; ; @@ -1559,22 +1560,13 @@ tag)))))) (define (build-docs-label entry-desc) - (let ([libs (exported-index-desc-from-libs entry-desc)]) - (cond - [(null? libs) - (format - (string-constant cs-view-docs) - (exported-index-desc-name entry-desc))] - [else - (format - (string-constant cs-view-docs-from) - (format - (string-constant cs-view-docs) - (exported-index-desc-name entry-desc)) - (apply string-append - (add-between - (map (λ (x) (format "~s" x)) libs) - ", ")))]))) + (define libs (exported-index-desc-from-libs entry-desc)) + (cond + [(null? libs) (format (string-constant cs-view-docs) (exported-index-desc-name entry-desc))] + [else + (format (string-constant cs-view-docs-from) + (format (string-constant cs-view-docs) (exported-index-desc-name entry-desc)) + (apply string-append (add-between (map (λ (x) (format "~s" x)) libs) ", ")))])) ; ; From d22982ca8cb5900ac366fdc8f38c1338f44ba48f Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 4/6] Fix 1 occurrence of `if-else-false-to-and` This `if` expression can be refactored to an equivalent expression using `and`. --- drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index 4a513a2aa..7c9c72e6f 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -1112,7 +1112,7 @@ (define phase-shift (if (pair? phase+space-shift) (car phase+space-shift) phase+space-shift)) (define phase+space (list-ref binding 6)) (define phase (if (pair? phase+space) (car phase+space) phase+space)) - (define space (if (pair? phase+space) (cdr phase+space) #f)) + (define space (and (pair? phase+space) (cdr phase+space))) (when (and (number? phase-level) (not (= phase-level (+ phase-shift From 7347ef71f039e37548fcefa530a605d20f320c0a Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 5/6] 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/syncheck/traversals.rkt | 66 +++++++++---------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index 7c9c72e6f..e439766c9 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -1174,39 +1174,39 @@ ;; records the src locs of each 'end' position of each arrow) ;; to do this, but maybe lets leave that for another day. (define (annotate-counts connections) - (for ([(key val) (in-hash connections)]) - (when (list? val) - (define start (first val)) - (define end (second val)) - (define color? (third val)) - (define (show-starts) - (when (zero? start) - (define defs-text (current-annotations)) - (when defs-text - (send defs-text syncheck:unused-binder - (list-ref key 0) (list-ref key 1) (list-ref key 2)))) - (add-mouse-over/loc (list-ref key 0) (list-ref key 1) (list-ref key 2) - (cond - [(zero? start) - (string-constant cs-zero-varrefs)] - [(= 1 start) - (string-constant cs-one-varref)] - [else - (format (string-constant cs-n-varrefs) start)]))) - (define (show-ends) - (unless (= 1 end) - (add-mouse-over/loc (list-ref key 0) (list-ref key 1) (list-ref key 2) - (format (string-constant cs-binder-count) end)))) - (cond - [(zero? end) ;; assume this is a binder, show uses - #;(when (and color? (zero? start)) - (color-unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2))) - (show-starts)] - [(zero? start) ;; assume this is a use, show bindings (usually just one, so do nothing) - (show-ends)] - [else ;; crazyness, show both - (show-starts) - (show-ends)])))) + (for ([(key val) (in-hash connections)] + #:when (list? val)) + (define start (first val)) + (define end (second val)) + (define color? (third val)) + (define (show-starts) + (when (zero? start) + (define defs-text (current-annotations)) + (when defs-text + (send defs-text syncheck:unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2)))) + (add-mouse-over/loc (list-ref key 0) + (list-ref key 1) + (list-ref key 2) + (cond + [(zero? start) (string-constant cs-zero-varrefs)] + [(= 1 start) (string-constant cs-one-varref)] + [else (format (string-constant cs-n-varrefs) start)]))) + (define (show-ends) + (unless (= 1 end) + (add-mouse-over/loc (list-ref key 0) + (list-ref key 1) + (list-ref key 2) + (format (string-constant cs-binder-count) end)))) + (cond + ;; assume this is a binder, show uses + #;(when (and color? (zero? start)) + (color-unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2))) + [(zero? end) (show-starts)] + ;; assume this is a use, show bindings (usually just one, so do nothing) + [(zero? start) (show-ends)] + [else ;; crazyness, show both + (show-starts) + (show-ends)]))) ;; color-variable : syntax phase-level identifier-mapping -> void (define (color-variable var phase-level varsets) From 36ad6307ae018831d8cf9b0a4c32ab2f65eab0d3 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 26 Jul 2026 00:33:35 +0000 Subject: [PATCH 6/6] Fix 1 occurrence of `and-let-to-cond` Using `cond` allows converting `let` to internal definitions, reducing nesting --- .../drracket/private/syncheck/traversals.rkt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index e439766c9..41a9e7103 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -1222,10 +1222,11 @@ (define (is-lexical? b) (or (not b) (eq? b 'lexical) - (and (pair? b) - (let ([path (caddr b)]) - (and (module-path-index? path) - (self-module? path)))))) + (cond + [(pair? b) + (define path (caddr b)) + (and (module-path-index? path) (self-module? path))] + [else #f]))) ;; initialize-binder-connections : id-set connections -> void (define (initialize-binder-connections binders connections)