Skip to content

Automated Resyntax fixes #735

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

Merged
merged 6 commits into from
Apr 21, 2025
Merged

Automated Resyntax fixes #735

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
9499119
Fix 12 occurrences of `let-to-define`
resyntax-ci[bot] Apr 20, 2025
cd43c16
Fix 3 occurrences of `cond-let-to-cond-define`
resyntax-ci[bot] Apr 20, 2025
636e538
Fix 1 occurrence of `if-let-to-cond`
resyntax-ci[bot] Apr 20, 2025
9885210
Fix 1 occurrence of `for-each-to-for`
resyntax-ci[bot] Apr 20, 2025
f1a2034
Fix 2 occurrences of `instantiate-to-new`
resyntax-ci[bot] Apr 20, 2025
695b61b
Fix 1 occurrence of `map-to-for`
resyntax-ci[bot] Apr 20, 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
70 changes: 33 additions & 37 deletions drracket-core-lib/drracket/drracket.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,17 +24,15 @@
(flush-output))

(define (run-trace-thread)
(let ([evt (make-log-receiver (current-logger) 'info)])
(void
(thread
(λ ()
(let loop ()
(define vec (sync evt))
(define str (vector-ref vec 1))
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
(display str)
(newline))
(loop)))))))
(define evt (make-log-receiver (current-logger) 'info))
(void (thread (λ ()
(let loop ()
(define vec (sync evt))
(define str (vector-ref vec 1))
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
(display str)
(newline))
(loop))))))

(cond
[debugging?
Expand All @@ -57,14 +55,14 @@
(run-trace-thread)))]
[install-cm?
(flprintf "PLTDRCM: loading compilation manager\n")
(let ([make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))])
(flprintf "PLTDRCM: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(when cm-trace?
(flprintf "PLTDRCM: enabling CM tracing\n")
(run-trace-thread)))]
(define make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))
(flprintf "PLTDRCM: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(when cm-trace?
(flprintf "PLTDRCM: enabling CM tracing\n")
(run-trace-thread))]
[first-parallel?
(flprintf "PLTDRPAR: loading compilation manager\n")
(define tools? (not (getenv "PLTNOTOOLS")))
Expand All @@ -90,19 +88,17 @@
(define (tool-files id)
(apply
append
(map
(λ (x)
(define proc (get-info/full x))
(if proc
(map (λ (dirs)
(apply build-path
x
(if (list? dirs)
dirs
(list dirs))))
(proc id (λ () '())))
'()))
(find-relevant-directories (list id)))))
(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 (λ () '())))
'()))))

(define make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)])
Expand Down Expand Up @@ -146,11 +142,11 @@
;; it creates a new custodian and installs it, but the
;; original eventspace was created on the original custodian
;; and this code does not create a new eventspace.
(let ([orig-cust (current-custodian)]
[orig-eventspace (current-eventspace)]
[new-cust (make-custodian)])
(current-custodian new-cust)
((dynamic-require 'drracket/private/profile-drs 'start-profile) orig-cust)))
(define orig-cust (current-custodian))
(current-eventspace)
(define new-cust (make-custodian))
(current-custodian new-cust)
((dynamic-require 'drracket/private/profile-drs 'start-profile) orig-cust))

(dynamic-require 'drracket/private/drracket-normal #f)

Expand Down
211 changes: 102 additions & 109 deletions drracket-core-lib/drracket/sprof.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,44 +14,40 @@
(define traces-table (make-hash))
(let loop ([i 0])
(sleep pause-time)
(let ([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)
(cond
[(zero? i)
(update-gui traces-table)
(loop update-frequency)]
[else
(loop (- i 1))]))))))
(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)
(cond
[(zero? i)
(update-gui traces-table)
(loop update-frequency)]
[else (loop (- i 1))])))))

(define (format-fn-name i)
(let ([id (car i)]
[src (cdr i)])
(cond
[id (format "~a" id)]
[src
(format "~a:~a~a"
(cond
[(path? (srcloc-source src))
(let-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))
(srcloc-position src))
(if id
(format ": ~a" id)
""))]
[else "???"])))
(define id (car i))
(define src (cdr i))
(cond
[id (format "~a" id)]
[src
(format "~a:~a~a"
(cond
[(path? (srcloc-source src))
(let-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))
(srcloc-position src))
(if id
(format ": ~a" id)
""))]
[else "???"]))

(define (insert-long-fn-name t i)
(send t begin-edit-sequence)
Expand All @@ -76,8 +72,8 @@
(send t end-edit-sequence))

(define (format-percentage n)
(let ([trunc (floor (* n 100))])
(format "~a%" (pad3 trunc))))
(define trunc (floor (* n 100)))
(format "~a%" (pad3 trunc)))

(define (pad3 n)
(cond
Expand Down Expand Up @@ -110,16 +106,16 @@
(define/override (on-event event)
(cond
[(send event button-up? 'left)
(let ([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))))))]
(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)))))]
[else (void)]))

(define/public (set-gui-display-data/refresh traces-table)
Expand All @@ -140,42 +136,42 @@
(set! line-to-source (make-hasheq))
(clear-old-pr)
(set! clear-old-pr void)
(let* ([denom-ht (make-hasheq)]
[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)]
[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))]))]))
(lock #t)
(end-edit-sequence)
(update-info-editor clicked-srcloc-pr)
(send open-button enable (and clicked-srcloc-pr (path? (srcloc-source (cdr clicked-srcloc-pr)))))))
(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))
(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))]))]))
(lock #t)
(end-edit-sequence)
(update-info-editor clicked-srcloc-pr)
(send open-button enable
(and clicked-srcloc-pr (path? (srcloc-source (cdr clicked-srcloc-pr))))))

(define/private (filter-stacks stacks)
(cond
Expand All @@ -187,11 +183,11 @@

(define/public (open-current-pr)
(when clicked-srcloc-pr
(let ([src (cdr clicked-srcloc-pr)])
(when (path? (srcloc-source src))
(printf "open ~s\n" (srcloc-source src))
(when (number? (srcloc-position src))
(printf "go to ~s\n" (srcloc-position src)))))))
(define src (cdr clicked-srcloc-pr))
(when (path? (srcloc-source src))
(printf "open ~s\n" (srcloc-source src))
(when (number? (srcloc-position src))
(printf "go to ~s\n" (srcloc-position src))))))

(define/private (update-info-editor pr)
(send vp change-children (λ (l) (if pr (list ec1 lp) (list ec1))))
Expand Down Expand Up @@ -295,17 +291,15 @@
(define show/hide-menu-item #f)

(define/public (show/hide-sprof-panel show?)
(let ([main-children (send main-panel get-children)])
(send show/hide-menu-item
set-label
(if show? sc-hide-sprof sc-show-sprof))
(unless (or (and show? (= 2 (length main-children)))
(and (not show?) (= 1 (length main-children))))
(send main-panel change-children
(λ (l)
(if show?
(list everything-else sprof-main-panel)
(list everything-else)))))))
(define main-children (send main-panel get-children))
(send show/hide-menu-item set-label (if show? sc-hide-sprof sc-show-sprof))
(unless (or (and show? (= 2 (length main-children)))
(and (not show?) (= 1 (length main-children))))
(send main-panel change-children
(λ (l)
(if show?
(list everything-else sprof-main-panel)
(list everything-else))))))

(define/override (make-root-area-container cls parent)
(set! main-panel (super make-root-area-container panel:horizontal-dragable% parent))
Expand Down Expand Up @@ -377,15 +371,14 @@
(mixin (drscheme:rep:text<%>) ()
(inherit get-user-custodian)
(define/public (get-threads-to-profile)
(let ([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)))
thds))
(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)))
thds)

;; FIX
;; something needs to happen here so that the profiling gets shutdown when the repl dies.
Expand Down
17 changes: 8 additions & 9 deletions drracket/drracket/plt-installer-tool.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,15 +77,14 @@
;; browse : -> void
;; gets the name of a file from the user and updates file-text-field
(define (browse)
(let ([filename (parameterize ([finder:default-extension "plt"]
[finder:default-filters
(if (eq? (system-type) 'macosx)
(finder:default-filters)
'(("PLT Files" "*.plt")
("Any" "*.*")))])
(finder:get-file #f "" #f "" dialog))])
(when filename
(send file-text-field set-value (path->string filename)))))
(define filename
(parameterize ([finder:default-extension "plt"]
[finder:default-filters (if (eq? (system-type) 'macosx)
(finder:default-filters)
'(("PLT Files" "*.plt") ("Any" "*.*")))])
(finder:get-file #f "" #f "" dialog)))
(when filename
(send file-text-field set-value (path->string filename))))
;; from-web? : -> boolean
;; returns #t if the user has selected a web address
(define (from-web?)
Expand Down
Loading