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 all commits
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
46 changes: 21 additions & 25 deletions drracket-core-lib/drracket/drracket.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,29 +30,26 @@
(define vec (sync evt))
(define str (vector-ref vec 1))
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
(display str)
(newline))
(displayln str))
(loop))))))

(cond
[debugging?
(flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
(let-values ([(zo-compile
make-compilation-manager-load/use-compiled-handler)
(parameterize ([current-namespace (make-base-empty-namespace)]
[use-compiled-file-paths '()])
(values
(dynamic-require 'errortrace/zo-compile 'zo-compile)
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))])
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
(current-compile zo-compile)
(use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
'errortrace-error-display-handler))
(when cm-trace?
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
(run-trace-thread)))]
(define-values (zo-compile make-compilation-manager-load/use-compiled-handler)
(parameterize ([current-namespace (make-base-empty-namespace)]
[use-compiled-file-paths '()])
(values (dynamic-require 'errortrace/zo-compile 'zo-compile)
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))))
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
(current-compile zo-compile)
(use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
'errortrace-error-display-handler))
(when cm-trace?
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
(run-trace-thread))]
[install-cm?
(flprintf "PLTDRCM: loading compilation manager\n")
(define make-compilation-manager-load/use-compiled-handler
Expand Down Expand Up @@ -91,13 +88,12 @@
(for/list ([x (in-list (find-relevant-directories (list id)))])
(define proc (get-info/full x))
(if proc
(map (λ (dirs)
(apply build-path
x
(if (list? dirs)
dirs
(list dirs))))
(proc id (λ () '())))
(for/list ([dirs (in-list (proc id (λ () '())))])
(apply build-path
x
(if (list? dirs)
dirs
(list dirs))))
'()))))

(define make-compilation-manager-load/use-compiled-handler
Expand Down
84 changes: 40 additions & 44 deletions drracket-core-lib/drracket/sprof.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,13 +16,11 @@
(sleep pause-time)
(define new-traces
(map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads)))
(for-each (λ (trace)
(for-each (λ (line)
(hash-set! traces-table
line
(cons trace (hash-ref traces-table line '()))))
trace))
new-traces)
(for ([trace (in-list new-traces)])
(for-each
(λ (line)
(hash-set! traces-table line (cons trace (hash-ref traces-table line '()))))
trace))
(cond
[(zero? i)
(update-gui traces-table)
Expand All @@ -38,8 +36,8 @@
(format "~a:~a~a"
(cond
[(path? (srcloc-source src))
(let-values ([(base name dir?) (split-path (srcloc-source src))])
name)]
(define-values (base name dir?) (split-path (srcloc-source src)))
name]
[else (srcloc-source src)])
(if (srcloc-line src)
(format "~a:~a" (srcloc-line src) (srcloc-column src))
Expand Down Expand Up @@ -108,14 +106,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 All @@ -138,35 +136,34 @@
(set! clear-old-pr void)
(define denom-ht (make-hasheq))
(define filtered-gui-display-data
(map (λ (pr)
(let ([id (car pr)]
[stacks (filter-stacks (cdr pr))])
(for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
(cons id stacks)))
gui-display-data))
(for/list ([pr (in-list gui-display-data)])
(define id (car pr))
(define stacks (filter-stacks (cdr pr)))
(for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
(cons id stacks)))
(define denom-count (hash-count denom-ht))
(let loop ([prs filtered-gui-display-data]
[first? #t]
[i 0])
(cond
[(null? prs) (void)]
[else
(let* ([pr (car prs)]
[fn (car pr)]
[count (length (cdr pr))])
(cond
[(zero? count) (loop (cdr prs) first? i)]
[else
(unless first?
(insert "\n"))
(let ([before (last-position)])
(hash-set! line-to-source i pr)
(insert (format-percentage (/ count denom-count)))
(insert (format " ~a" (format-fn-name fn)))
(let ([after (last-position)])
(when (equal? (car pr) clicked-srcloc-pr)
(set! clear-old-pr (highlight-range before after "NavajoWhite")))))
(loop (cdr prs) #f (+ i 1))]))]))
(define pr (car prs))
(define fn (car pr))
(define count (length (cdr pr)))
(cond
[(zero? count) (loop (cdr prs) first? i)]
[else
(unless first?
(insert "\n"))
(let ([before (last-position)])
(hash-set! line-to-source i pr)
(insert (format-percentage (/ count denom-count)))
(insert (format " ~a" (format-fn-name fn)))
(let ([after (last-position)])
(when (equal? (car pr) clicked-srcloc-pr)
(set! clear-old-pr (highlight-range before after "NavajoWhite")))))
(loop (cdr prs) #f (+ i 1))])]))
(lock #t)
(end-edit-sequence)
(update-info-editor clicked-srcloc-pr)
Expand Down Expand Up @@ -373,11 +370,10 @@
(define/public (get-threads-to-profile)
(define thds '())
(let loop ([cust (get-user-custodian)])
(for-each (λ (obj)
(cond
[(custodian? obj) (loop obj)]
[(thread? obj) (set! thds (cons obj thds))]))
(custodian-managed-list cust system-custodian)))
(for ([obj (in-list (custodian-managed-list cust system-custodian))])
(cond
[(custodian? obj) (loop obj)]
[(thread? obj) (set! thds (cons obj thds))])))
thds)

;; FIX
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
Loading