Skip to content

Commit be49042

Browse files
resyntax-ci[bot]rfindler
resyntax-ci[bot]
authored and
rfindler
committed
Some fixes from Resyntax are merged together here with some small fixes
closes #745 Fix 5 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. Fix 1 occurrence of `display-and-newline-to-displayln` The `displayln` function can be used to display a value with a newline after it. Fix 3 occurrences of `cond-let-to-cond-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. Fix 2 occurrences of `map-to-for` This `map` operation can be replaced with a `for/list` loop. Fix 2 occurrences of `for-each-to-for` This `for-each` operation can be replaced with a `for` loop. Fix 1 occurrence of `if-begin-to-cond` Using `cond` instead of `if` here makes `begin` unnecessary Fix 3 occurrences of `hash-for-each-to-for` This `hash-for-each` operation can be replaced with a `for` loop. Fix 2 occurrences of `if-let-to-cond` `cond` with internal definitions is preferred over `if` with `let`, to reduce nesting Fix 1 occurrence of `flat-contract-migration` flat-contract is a legacy form for constructing contracts from predicates; predicates can be used directly as contracts now.
1 parent e9578a7 commit be49042

File tree

5 files changed

+245
-248
lines changed

5 files changed

+245
-248
lines changed

‎drracket-core-lib/drracket/drracket.rkt

Lines changed: 21 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -30,29 +30,26 @@
3030
(define vec (sync evt))
3131
(define str (vector-ref vec 1))
3232
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
33-
(display str)
34-
(newline))
33+
(displayln str))
3534
(loop))))))
3635

3736
(cond
3837
[debugging?
3938
(flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
40-
(let-values ([(zo-compile
41-
make-compilation-manager-load/use-compiled-handler)
42-
(parameterize ([current-namespace (make-base-empty-namespace)]
43-
[use-compiled-file-paths '()])
44-
(values
45-
(dynamic-require 'errortrace/zo-compile 'zo-compile)
46-
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))])
47-
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
48-
(current-compile zo-compile)
49-
(use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
50-
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
51-
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
52-
'errortrace-error-display-handler))
53-
(when cm-trace?
54-
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
55-
(run-trace-thread)))]
39+
(define-values (zo-compile make-compilation-manager-load/use-compiled-handler)
40+
(parameterize ([current-namespace (make-base-empty-namespace)]
41+
[use-compiled-file-paths '()])
42+
(values (dynamic-require 'errortrace/zo-compile 'zo-compile)
43+
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))))
44+
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
45+
(current-compile zo-compile)
46+
(use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
47+
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
48+
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
49+
'errortrace-error-display-handler))
50+
(when cm-trace?
51+
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
52+
(run-trace-thread))]
5653
[install-cm?
5754
(flprintf "PLTDRCM: loading compilation manager\n")
5855
(define make-compilation-manager-load/use-compiled-handler
@@ -91,13 +88,12 @@
9188
(for/list ([x (in-list (find-relevant-directories (list id)))])
9289
(define proc (get-info/full x))
9390
(if proc
94-
(map (λ (dirs)
95-
(apply build-path
96-
x
97-
(if (list? dirs)
98-
dirs
99-
(list dirs))))
100-
(proc id (λ () '())))
91+
(for/list ([dirs (in-list (proc id (λ () '())))])
92+
(apply build-path
93+
x
94+
(if (list? dirs)
95+
dirs
96+
(list dirs))))
10197
'()))))
10298

10399
(define make-compilation-manager-load/use-compiled-handler

‎drracket-core-lib/drracket/sprof.rkt

Lines changed: 40 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -16,13 +16,11 @@
1616
(sleep pause-time)
1717
(define new-traces
1818
(map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads)))
19-
(for-each (λ (trace)
20-
(for-each (λ (line)
21-
(hash-set! traces-table
22-
line
23-
(cons trace (hash-ref traces-table line '()))))
24-
trace))
25-
new-traces)
19+
(for ([trace (in-list new-traces)])
20+
(for-each
21+
(λ (line)
22+
(hash-set! traces-table line (cons trace (hash-ref traces-table line '()))))
23+
trace))
2624
(cond
2725
[(zero? i)
2826
(update-gui traces-table)
@@ -38,8 +36,8 @@
3836
(format "~a:~a~a"
3937
(cond
4038
[(path? (srcloc-source src))
41-
(let-values ([(base name dir?) (split-path (srcloc-source src))])
42-
name)]
39+
(define-values (base name dir?) (split-path (srcloc-source src)))
40+
name]
4341
[else (srcloc-source src)])
4442
(if (srcloc-line src)
4543
(format "~a:~a" (srcloc-line src) (srcloc-column src))
@@ -108,14 +106,14 @@
108106
[(send event button-up? 'left)
109107
(define admin (get-admin))
110108
(when admin
111-
(let ([dc (send admin get-dc)])
112-
(let-values ([(x y) (dc-location-to-editor-location (send event get-x)
113-
(send event get-y))])
114-
(let* ([loc (find-position x y)]
115-
[para (position-paragraph loc)])
116-
(set! clicked-srcloc-pr
117-
(and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
118-
(update-gui-display)))))]
109+
(send admin get-dc)
110+
(define-values (x y)
111+
(dc-location-to-editor-location (send event get-x) (send event get-y)))
112+
(define loc (find-position x y))
113+
(define para (position-paragraph loc))
114+
(set! clicked-srcloc-pr
115+
(and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
116+
(update-gui-display))]
119117
[else (void)]))
120118

121119
(define/public (set-gui-display-data/refresh traces-table)
@@ -138,35 +136,34 @@
138136
(set! clear-old-pr void)
139137
(define denom-ht (make-hasheq))
140138
(define filtered-gui-display-data
141-
(map (λ (pr)
142-
(let ([id (car pr)]
143-
[stacks (filter-stacks (cdr pr))])
144-
(for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
145-
(cons id stacks)))
146-
gui-display-data))
139+
(for/list ([pr (in-list gui-display-data)])
140+
(define id (car pr))
141+
(define stacks (filter-stacks (cdr pr)))
142+
(for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
143+
(cons id stacks)))
147144
(define denom-count (hash-count denom-ht))
148145
(let loop ([prs filtered-gui-display-data]
149146
[first? #t]
150147
[i 0])
151148
(cond
152149
[(null? prs) (void)]
153150
[else
154-
(let* ([pr (car prs)]
155-
[fn (car pr)]
156-
[count (length (cdr pr))])
157-
(cond
158-
[(zero? count) (loop (cdr prs) first? i)]
159-
[else
160-
(unless first?
161-
(insert "\n"))
162-
(let ([before (last-position)])
163-
(hash-set! line-to-source i pr)
164-
(insert (format-percentage (/ count denom-count)))
165-
(insert (format " ~a" (format-fn-name fn)))
166-
(let ([after (last-position)])
167-
(when (equal? (car pr) clicked-srcloc-pr)
168-
(set! clear-old-pr (highlight-range before after "NavajoWhite")))))
169-
(loop (cdr prs) #f (+ i 1))]))]))
151+
(define pr (car prs))
152+
(define fn (car pr))
153+
(define count (length (cdr pr)))
154+
(cond
155+
[(zero? count) (loop (cdr prs) first? i)]
156+
[else
157+
(unless first?
158+
(insert "\n"))
159+
(let ([before (last-position)])
160+
(hash-set! line-to-source i pr)
161+
(insert (format-percentage (/ count denom-count)))
162+
(insert (format " ~a" (format-fn-name fn)))
163+
(let ([after (last-position)])
164+
(when (equal? (car pr) clicked-srcloc-pr)
165+
(set! clear-old-pr (highlight-range before after "NavajoWhite")))))
166+
(loop (cdr prs) #f (+ i 1))])]))
170167
(lock #t)
171168
(end-edit-sequence)
172169
(update-info-editor clicked-srcloc-pr)
@@ -373,11 +370,10 @@
373370
(define/public (get-threads-to-profile)
374371
(define thds '())
375372
(let loop ([cust (get-user-custodian)])
376-
(for-each (λ (obj)
377-
(cond
378-
[(custodian? obj) (loop obj)]
379-
[(thread? obj) (set! thds (cons obj thds))]))
380-
(custodian-managed-list cust system-custodian)))
373+
(for ([obj (in-list (custodian-managed-list cust system-custodian))])
374+
(cond
375+
[(custodian? obj) (loop obj)]
376+
[(thread? obj) (set! thds (cons obj thds))])))
381377
thds)
382378

383379
;; FIX

‎drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt

Lines changed: 72 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -48,76 +48,79 @@
4848
(λ (sexp [ignored void])
4949
(parameterize ([current-directory (or user-directory (current-directory))]
5050
[current-load-relative-directory user-directory])
51-
(let ([is-module? (syntax-case sexp (module)
52-
[(module . rest) #t]
53-
[_ #f])])
54-
(cond
55-
[is-module?
56-
(let ([phase-to-binders (make-hash)]
57-
[phase-to-varrefs (make-hash)]
58-
[phase-to-varsets (make-hash)]
59-
[phase-to-tops (make-hash)]
60-
[phase-to-requires (make-hash)]
61-
[binding-inits (make-hash)]
62-
[templrefs (make-id-set 0)]
63-
[module-lang-requires (make-hash)]
64-
[requires (make-hash)]
65-
[require-for-syntaxes (make-hash)]
66-
[require-for-templates (make-hash)]
67-
[require-for-labels (make-hash)]
68-
[sub-identifier-binding-directives (make-hash)])
69-
(annotate-basic sexp
70-
user-namespace user-directory
71-
phase-to-binders
72-
phase-to-varrefs
73-
phase-to-varsets
74-
phase-to-tops
75-
binding-inits
76-
templrefs
77-
module-lang-requires
78-
phase-to-requires
79-
sub-identifier-binding-directives)
80-
(annotate-variables user-namespace
81-
user-directory
82-
phase-to-binders
83-
phase-to-varrefs
84-
phase-to-varsets
85-
phase-to-tops
86-
templrefs
87-
module-lang-requires
88-
phase-to-requires
89-
sub-identifier-binding-directives)
90-
(annotate-contracts sexp
91-
(hash-ref phase-to-binders 0 (λ () (make-id-set 0)))
92-
(hash-ref binding-inits 0 (λ () (make-id-set 0)))
93-
binder+mods-binder)
94-
(when print-extra-info?
95-
(print-extra-info (list (list 'phase-to-binders phase-to-binders)
96-
(list 'phase-to-varrefs phase-to-varrefs)
97-
(list 'phase-to-varsets phase-to-varsets)
98-
(list 'phase-to-tops phase-to-tops)
99-
(list 'phase-to-requires phase-to-requires)
100-
(list 'binding-inits binding-inits)
101-
(list 'templrefs templrefs)
102-
(list 'module-lang-requires module-lang-requires)
103-
(list 'requires requires)
104-
(list 'require-for-syntaxes require-for-syntaxes)
105-
(list 'require-for-templates require-for-templates)
106-
(list 'require-for-labels require-for-labels)
107-
(list 'sub-identifier-binding-directives
108-
sub-identifier-binding-directives)))))]
109-
[else
51+
(define is-module?
52+
(syntax-case sexp (module)
53+
[(module . rest) #t]
54+
[_ #f]))
55+
(cond
56+
[is-module?
57+
(let ([phase-to-binders (make-hash)]
58+
[phase-to-varrefs (make-hash)]
59+
[phase-to-varsets (make-hash)]
60+
[phase-to-tops (make-hash)]
61+
[phase-to-requires (make-hash)]
62+
[binding-inits (make-hash)]
63+
[templrefs (make-id-set 0)]
64+
[module-lang-requires (make-hash)]
65+
[requires (make-hash)]
66+
[require-for-syntaxes (make-hash)]
67+
[require-for-templates (make-hash)]
68+
[require-for-labels (make-hash)]
69+
[sub-identifier-binding-directives (make-hash)])
11070
(annotate-basic sexp
111-
user-namespace user-directory
112-
tl-phase-to-binders
113-
tl-phase-to-varrefs
114-
tl-phase-to-varsets
115-
tl-phase-to-tops
116-
tl-binding-inits
117-
tl-templrefs
118-
tl-module-lang-requires
119-
tl-phase-to-requires
120-
tl-sub-identifier-binding-directives)]))))]
71+
user-namespace
72+
user-directory
73+
phase-to-binders
74+
phase-to-varrefs
75+
phase-to-varsets
76+
phase-to-tops
77+
binding-inits
78+
templrefs
79+
module-lang-requires
80+
phase-to-requires
81+
sub-identifier-binding-directives)
82+
(annotate-variables user-namespace
83+
user-directory
84+
phase-to-binders
85+
phase-to-varrefs
86+
phase-to-varsets
87+
phase-to-tops
88+
templrefs
89+
module-lang-requires
90+
phase-to-requires
91+
sub-identifier-binding-directives)
92+
(annotate-contracts sexp
93+
(hash-ref phase-to-binders 0 (λ () (make-id-set 0)))
94+
(hash-ref binding-inits 0 (λ () (make-id-set 0)))
95+
binder+mods-binder)
96+
(when print-extra-info?
97+
(print-extra-info (list (list 'phase-to-binders phase-to-binders)
98+
(list 'phase-to-varrefs phase-to-varrefs)
99+
(list 'phase-to-varsets phase-to-varsets)
100+
(list 'phase-to-tops phase-to-tops)
101+
(list 'phase-to-requires phase-to-requires)
102+
(list 'binding-inits binding-inits)
103+
(list 'templrefs templrefs)
104+
(list 'module-lang-requires module-lang-requires)
105+
(list 'requires requires)
106+
(list 'require-for-syntaxes require-for-syntaxes)
107+
(list 'require-for-templates require-for-templates)
108+
(list 'require-for-labels require-for-labels)
109+
(list 'sub-identifier-binding-directives
110+
sub-identifier-binding-directives)))))]
111+
[else
112+
(annotate-basic sexp
113+
user-namespace
114+
user-directory
115+
tl-phase-to-binders
116+
tl-phase-to-varrefs
117+
tl-phase-to-varsets
118+
tl-phase-to-tops
119+
tl-binding-inits
120+
tl-templrefs
121+
tl-module-lang-requires
122+
tl-phase-to-requires
123+
tl-sub-identifier-binding-directives)])))]
121124
[expansion-completed
122125
(λ ()
123126
(parameterize ([current-directory (or user-directory (current-directory))]

0 commit comments

Comments
 (0)