Skip to content

Automated Resyntax fixes #745

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
resyntax-ci wants to merge 9 commits into from
Closed

Automated Resyntax fixes #745

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
7e356e0
Fix 5 occurrences of `let-to-define`
resyntax-ci[bot] Jun 1, 2025
810b5dc
Fix 1 occurrence of `display-and-newline-to-displayln`
resyntax-ci[bot] Jun 1, 2025
c55f3af
Fix 3 occurrences of `cond-let-to-cond-define`
resyntax-ci[bot] Jun 1, 2025
64ea469
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] Jun 1, 2025
639e28a
Fix 2 occurrences of `for-each-to-for`
resyntax-ci[bot] Jun 1, 2025
8478c80
Fix 1 occurrence of `if-begin-to-cond`
resyntax-ci[bot] Jun 1, 2025
e513950
Fix 3 occurrences of `hash-for-each-to-for`
resyntax-ci[bot] Jun 1, 2025
171b505
Fix 2 occurrences of `if-let-to-cond`
resyntax-ci[bot] Jun 1, 2025
7de09db
Fix 1 occurrence of `flat-contract-migration`
resyntax-ci[bot] Jun 1, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 8 additions & 8 deletions drracket-core-lib/drracket/sprof.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -108,14 +108,14 @@
[(send event button-up? 'left)
(define admin (get-admin))
(when admin
(let ([dc (send admin get-dc)])
(let-values ([(x y) (dc-location-to-editor-location (send event get-x)
(send event get-y))])
(let* ([loc (find-position x y)]
[para (position-paragraph loc)])
(set! clicked-srcloc-pr
(and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
(update-gui-display)))))]
(send admin get-dc)
(define-values (x y)
(dc-location-to-editor-location (send event get-x) (send event get-y)))
(define loc (find-position x y))
(define para (position-paragraph loc))
(set! clicked-srcloc-pr
(and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
(update-gui-display))]
[else (void)]))

(define/public (set-gui-display-data/refresh traces-table)
Expand Down
143 changes: 74 additions & 69 deletions drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,76 +48,81 @@
(λ (sexp [ignored void])
(parameterize ([current-directory (or user-directory (current-directory))]
[current-load-relative-directory user-directory])
(let ([is-module? (syntax-case sexp (module)
[(module . rest) #t]
[_ #f])])
(cond
[is-module?
(let ([phase-to-binders (make-hash)]
[phase-to-varrefs (make-hash)]
[phase-to-varsets (make-hash)]
[phase-to-tops (make-hash)]
[phase-to-requires (make-hash)]
[binding-inits (make-hash)]
[templrefs (make-id-set 0)]
[module-lang-requires (make-hash)]
[requires (make-hash)]
[require-for-syntaxes (make-hash)]
[require-for-templates (make-hash)]
[require-for-labels (make-hash)]
[sub-identifier-binding-directives (make-hash)])
(annotate-basic sexp
user-namespace user-directory
phase-to-binders
phase-to-varrefs
phase-to-varsets
phase-to-tops
binding-inits
templrefs
module-lang-requires
phase-to-requires
sub-identifier-binding-directives)
(annotate-variables user-namespace
user-directory
phase-to-binders
phase-to-varrefs
phase-to-varsets
phase-to-tops
templrefs
module-lang-requires
phase-to-requires
sub-identifier-binding-directives)
(annotate-contracts sexp
(hash-ref phase-to-binders 0 (λ () (make-id-set 0)))
(hash-ref binding-inits 0 (λ () (make-id-set 0)))
binder+mods-binder)
(when print-extra-info?
(print-extra-info (list (list 'phase-to-binders phase-to-binders)
(list 'phase-to-varrefs phase-to-varrefs)
(list 'phase-to-varsets phase-to-varsets)
(list 'phase-to-tops phase-to-tops)
(list 'phase-to-requires phase-to-requires)
(list 'binding-inits binding-inits)
(list 'templrefs templrefs)
(list 'module-lang-requires module-lang-requires)
(list 'requires requires)
(list 'require-for-syntaxes require-for-syntaxes)
(list 'require-for-templates require-for-templates)
(list 'require-for-labels require-for-labels)
(list 'sub-identifier-binding-directives
sub-identifier-binding-directives)))))]
[else
(define is-module?
(syntax-case sexp (module)
[(module . rest
)
Copy link
Member

@rfindler rfindler Jun 2, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this doesn't seem good.

Copy link
Member

@rfindler rfindler Jun 8, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@sorawee is this your department?

Copy link
Contributor

@sorawee sorawee Jun 8, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes :/. This particular instance should be easy to fix.

#t]
[_ #f]))
(cond
[is-module?
(let ([phase-to-binders (make-hash)]
[phase-to-varrefs (make-hash)]
[phase-to-varsets (make-hash)]
[phase-to-tops (make-hash)]
[phase-to-requires (make-hash)]
[binding-inits (make-hash)]
[templrefs (make-id-set 0)]
[module-lang-requires (make-hash)]
[requires (make-hash)]
[require-for-syntaxes (make-hash)]
[require-for-templates (make-hash)]
[require-for-labels (make-hash)]
[sub-identifier-binding-directives (make-hash)])
(annotate-basic sexp
user-namespace user-directory
tl-phase-to-binders
tl-phase-to-varrefs
tl-phase-to-varsets
tl-phase-to-tops
tl-binding-inits
tl-templrefs
tl-module-lang-requires
tl-phase-to-requires
tl-sub-identifier-binding-directives)]))))]
user-namespace
user-directory
phase-to-binders
phase-to-varrefs
phase-to-varsets
phase-to-tops
binding-inits
templrefs
module-lang-requires
phase-to-requires
sub-identifier-binding-directives)
(annotate-variables user-namespace
user-directory
phase-to-binders
phase-to-varrefs
phase-to-varsets
phase-to-tops
templrefs
module-lang-requires
phase-to-requires
sub-identifier-binding-directives)
(annotate-contracts sexp
(hash-ref phase-to-binders 0 (λ () (make-id-set 0)))
(hash-ref binding-inits 0 (λ () (make-id-set 0)))
binder+mods-binder)
(when print-extra-info?
(print-extra-info (list (list 'phase-to-binders phase-to-binders)
(list 'phase-to-varrefs phase-to-varrefs)
(list 'phase-to-varsets phase-to-varsets)
(list 'phase-to-tops phase-to-tops)
(list 'phase-to-requires phase-to-requires)
(list 'binding-inits binding-inits)
(list 'templrefs templrefs)
(list 'module-lang-requires module-lang-requires)
(list 'requires requires)
(list 'require-for-syntaxes require-for-syntaxes)
(list 'require-for-templates require-for-templates)
(list 'require-for-labels require-for-labels)
(list 'sub-identifier-binding-directives
sub-identifier-binding-directives)))))]
[else
(annotate-basic sexp
user-namespace
user-directory
tl-phase-to-binders
tl-phase-to-varrefs
tl-phase-to-varsets
tl-phase-to-tops
tl-binding-inits
tl-templrefs
tl-module-lang-requires
tl-phase-to-requires
tl-sub-identifier-binding-directives)])))]
[expansion-completed
(λ ()
(parameterize ([current-directory (or user-directory (current-directory))]
Expand Down
103 changes: 54 additions & 49 deletions drracket/gui-debugger/debug-tool.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -804,11 +804,11 @@
; break-after
(case-lambda
[(top-mark ccm val)
(let* ([debug-marks (continuation-mark-set->list ccm debug-key)])
(car (send (get-tab) suspend
oeh
(cons top-mark debug-marks)
(list 'exit-break val))))]
(define debug-marks (continuation-mark-set->list ccm debug-key))
(car (send (get-tab) suspend
oeh
(cons top-mark debug-marks)
(list 'exit-break val)))]
[(top-mark ccm . vals)
(define debug-marks (continuation-mark-set->list ccm debug-key))
(apply values
Expand Down Expand Up @@ -1237,37 +1237,37 @@
(send variables-text end-edit-sequence))

(define/public (register-stack-frames frames already-stopped?)
(let* ([trimmed-exprs
(map (lambda (frame)
(let ([expr (mark-source frame)])
(cond
; should succeed unless the user closes a secondary tab during debugging
[(and expr (filename->defs (syntax-source expr)))
=> (lambda (defs)
(trim-expr-str
(if (syntax-position expr)
(send defs get-text
(sub1 (syntax-position expr))
(+ -1 (syntax-position expr) (syntax-span expr)))
"??")
15))]
["??"])))
frames)]
[trimmed-lengths (map add1 (map string-length trimmed-exprs))]
[positions (foldl + 0 trimmed-lengths)])
(send stack-frames begin-edit-sequence)
(send stack-frames lock #f)
(unless already-stopped?
(send stack-frames delete 0 (send stack-frames last-position))
(for-each (lambda (trimmed-expr)
(send stack-frames insert (format "~a\n" trimmed-expr)))
trimmed-exprs))
(send stack-frames change-style normal-sd 0 (send stack-frames last-position))
(send stack-frames change-style bold-sd
(send stack-frames paragraph-start-position (send (get-current-tab) get-frame-num))
(send stack-frames paragraph-end-position (send (get-current-tab) get-frame-num)))
(send stack-frames lock #t)
(send stack-frames end-edit-sequence)))
(define trimmed-exprs
(map (lambda (frame)
(let ([expr (mark-source frame)])
(cond
; should succeed unless the user closes a secondary tab during debugging
[(and expr (filename->defs (syntax-source expr)))
=>
(lambda (defs)
(trim-expr-str (if (syntax-position expr)
(send defs get-text
(sub1 (syntax-position expr))
(+ -1 (syntax-position expr) (syntax-span expr)))
"??")
15))]
["??"])))
frames))
(define trimmed-lengths (map add1 (map string-length trimmed-exprs)))
Copy link
Member

@rfindler rfindler Jun 2, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

looks like trimmed-lengths also isn't used.

(foldl + 0 trimmed-lengths)
(send stack-frames begin-edit-sequence)
(send stack-frames lock #f)
(unless already-stopped?
(send stack-frames delete 0 (send stack-frames last-position))
(for-each (lambda (trimmed-expr) (send stack-frames insert (format "~a\n" trimmed-expr)))
trimmed-exprs))
(send stack-frames change-style normal-sd 0 (send stack-frames last-position))
(send stack-frames change-style
bold-sd
(send stack-frames paragraph-start-position (send (get-current-tab) get-frame-num))
(send stack-frames paragraph-end-position (send (get-current-tab) get-frame-num)))
(send stack-frames lock #t)
(send stack-frames end-edit-sequence))

(define/public (clear-stack-frames/vars)
(send stack-frames begin-edit-sequence)
Expand Down Expand Up @@ -1561,19 +1561,24 @@
(inner (void) on-tab-change old new))

(define/public (check-current-language-for-debugger)
(let* ([settings (send (get-definitions-text) get-next-settings)]
[lang (drscheme:language-configuration:language-settings-language settings)]
[visible? (and (send lang capability-value 'gui-debugger:debug-button)
(not (is-a? lang drscheme:module-language:module-language<%>)) ;; the opt-out button handles this language
(not (debugger-does-not-work-for?
(extract-language-level settings))))])
(define debug-parent (send debug-button get-parent))
(define debug-button-currently-visible? (member debug-button (send debug-parent get-children)))
(if visible?
(unless debug-button-currently-visible?
(send debug-parent add-child debug-button))
(when debug-button-currently-visible?
(send debug-parent delete-child debug-button)))))
(define settings (send (get-definitions-text) get-next-settings))
(define lang (drscheme:language-configuration:language-settings-language settings))
(define visible?
(and
(send lang capability-value 'gui-debugger:debug-button)
(not
(is-a?
lang
drscheme:module-language:module-language<%>)) ;; the opt-out button handles this language
(not (debugger-does-not-work-for? (extract-language-level settings)))))
(define debug-parent (send debug-button get-parent))
(define debug-button-currently-visible?
(member debug-button (send debug-parent get-children)))
(if visible?
(unless debug-button-currently-visible?
(send debug-parent add-child debug-button))
(when debug-button-currently-visible?
(send debug-parent delete-child debug-button))))

(send (get-button-panel) change-children
(lambda (children)
Expand Down