Skip to content

Commit 7921b8d

Browse files
resyntax-ci[bot]resyntax-ci[bot]
authored
Automated Resyntax fixes (#1441)
* Fix 10 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Fix 8 occurrences of `single-clause-match-to-match-define` This `match` expression can be simplified using `match-define`. * Fix 1 occurrence of `define-begin0-extraction` The `begin0` in this definition can be extracted into the surrounding definition context. * Fix 1 occurrence of `and-match-to-match` This `and` expression can be turned into a clause of the inner `match` expression, reducing nesting. * Fix 3 occurrences of `zero-comparison-to-positive?` This expression is equivalent to calling the `positive?` predicate. * Fix 3 occurrences of `define-values-values-to-define` This use of `define-values` is unnecessary. * Fix 1 occurrence of `unless-expression-in-for-loop-to-unless-keyword` Use the `#:unless` keyword instead of `unless` to reduce loop body indentation. * Fix 1 occurrence of `when-expression-in-for-loop-to-when-keyword` Use the `#:when` keyword instead of `when` to reduce loop body indentation. * Fix 4 occurrences of `if-begin-to-cond` Using `cond` instead of `if` here makes `begin` unnecessary * Fix 3 occurrences of `if-let-to-cond` `cond` with internal definitions is preferred over `if` with `let`, to reduce nesting * Fix 1 occurrence of `define-let-to-double-define` This `let` expression can be pulled up into a `define` expression. * Fix 1 occurrence of `always-throwing-cond-to-when` Using `when` and `unless` is simpler than a conditional with an always-throwing branch. * Fix 1 occurrence of `zero-comparison-lambda-to-positive?` This lambda function is equivalent to the built-in `positive?` predicate. * Fix 1 occurrence of `map-to-for` This `map` operation can be replaced with a `for/list` loop. * Fix 5 occurrences of `define-lambda-to-define` The `define` form supports a shorthand for defining functions. * Fix 2 occurrences of `inline-unnecessary-define` This variable is returned immediately and can be inlined. * Fix 1 occurrence of `for/fold-with-conditional-body-to-unless-keyword` This `for/fold` loop can be simplified by using the `#:unless` keyword. * Fix 1 occurrence of `inline-unnecessary-begin` This `begin` form can be flattened into the surrounding definition context. * Fix 1 occurrence of `inverted-when` This negated `when` expression can be replaced by an `unless` expression. * Fix 1 occurrence of `inverted-unless` This negated `unless` expression can be replaced by a `when` expression. --------- Co-authored-by: resyntax-ci[bot] <181813515+resyntax-ci[bot]@users.noreply.github.com>
1 parent e72b939 commit 7921b8d

17 files changed

+364
-352
lines changed

‎typed-racket-lib/typed-racket/private/parse-type.rkt

Lines changed: 27 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -183,8 +183,8 @@
183183
;; (Syntax -> Type) -> Syntax Any -> Syntax
184184
;; See `parse-type/id`. This is a curried generalization.
185185
(define ((parse/id p) loc datum)
186-
(let* ([stx* (datum->syntax loc datum loc loc)])
187-
(p stx*)))
186+
(define stx* (datum->syntax loc datum loc loc))
187+
(p stx*))
188188

189189
(define (parse-literal-alls stx)
190190
(syntax-parse stx
@@ -831,12 +831,11 @@
831831
refinement-type]
832832
[(:Instance^ t)
833833
(let ([v (do-parse #'t)])
834-
(if (not (or (F? v) (Mu? v) (Name? v) (Class? v) (Error? v)))
835-
(begin (parse-error #:delayed? #t
836-
"expected a class type for argument to Instance"
837-
"given" v)
838-
(make-Instance (Un)))
839-
(make-Instance v)))]
834+
(cond
835+
[(not (or (F? v) (Mu? v) (Name? v) (Class? v) (Error? v)))
836+
(parse-error #:delayed? #t "expected a class type for argument to Instance" "given" v)
837+
(make-Instance (Un))]
838+
[else (make-Instance v)]))]
840839
[(:Unit^ (:import^ import:id ...)
841840
(:export^ export:id ...)
842841
(~optional (:init-depend^ init-depend:id ...)
@@ -902,15 +901,16 @@
902901
(k Err)
903902
(remove-duplicates res)))
904903
([ty (in-syntax #'(tys ...))])
905-
(let ([t (do-parse ty)])
906-
(match (resolve t)
907-
[(Fun: arrows) (values (append res arrows) err?)]
908-
[_ (if (side-effect-mode? mode)
909-
(values res #t)
910-
(parse-error
911-
#:stx ty
912-
"expected a function type for component of case-> type"
913-
"given" t))]))))
904+
(define t (do-parse ty))
905+
(match (resolve t)
906+
[(Fun: arrows) (values (append res arrows) err?)]
907+
[_
908+
(if (side-effect-mode? mode)
909+
(values res #t)
910+
(parse-error #:stx ty
911+
"expected a function type for component of case-> type"
912+
"given"
913+
t))])))
914914
(make-Fun arrows))]
915915
[(:Rec^ x:id t)
916916
(let* ([var (syntax-e #'x)])
@@ -1401,8 +1401,7 @@
14011401
[_ (apply rator args^)])]))]
14021402
[(? Name?)
14031403
(resolve-app-check-error rator args^ stx)
1404-
(define app (make-App rator args^))
1405-
app]
1404+
(make-App rator args^)]
14061405
[(Error:) Err]
14071406
[_ (parse-error "bad syntax in type application: expected a type constructor"
14081407
"given a type"
@@ -1507,10 +1506,9 @@
15071506
;; Merge all the non-duplicate entries from the parent types
15081507
(define (merge-clause parent-clause clause)
15091508
(for/fold ([clause clause])
1510-
([(k v) (in-dict parent-clause)])
1511-
(if (dict-has-key? clause k)
1512-
clause
1513-
(dict-set clause k v))))
1509+
([(k v) (in-dict parent-clause)]
1510+
#:unless (dict-has-key? clause k))
1511+
(dict-set clause k v)))
15141512

15151513
(define (match-parent-type parent-type)
15161514
(define resolved (resolve parent-type))
@@ -1655,12 +1653,12 @@
16551653
;; of init arguments.
16561654
(define parent-inits (get-parent-inits parent/init-type))
16571655

1658-
(define class-type
1659-
(make-Class row-var
1660-
(append given-inits parent-inits)
1661-
fields methods augments given-init-rest))
1662-
1663-
class-type]
1656+
(make-Class row-var
1657+
(append given-inits parent-inits)
1658+
fields
1659+
methods
1660+
augments
1661+
given-init-rest)]
16641662
[else
16651663
;; Conservatively assume that if there *are* #:implements
16661664
;; clauses, then the current type alias will be recursive

‎typed-racket-lib/typed-racket/private/shallow-rewrite.rkt

Lines changed: 109 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -222,36 +222,48 @@
222222
[check-formal*
223223
(let protect-loop ([args #'formals]
224224
[dom* dom*])
225-
(if (or (identifier? args)
226-
(null? args)
227-
(and (syntax? args) (null? (syntax-e args))))
228-
'()
229-
(let*-values ([(fst rst)
230-
(cond
231-
[(pair? args)
232-
(values (car args) (cdr args))]
233-
[(syntax? args)
234-
(let ((e (syntax-e args)))
235-
(values (car e) (cdr e)))]
236-
[else
237-
(raise-syntax-error 'shallow-rewrite-top "#%plain-lambda formals" #'formals args)])]
238-
[(check*)
239-
(let ((dom+
240-
(for/fold ((acc '()))
241-
((dom (in-list dom*)))
242-
(if (pair? dom) (cons (cdr dom) acc) acc))))
243-
(protect-loop rst dom+))]
244-
[(fst-ty)
245-
(let ((ann-ty (and (type-annotation fst #:infer #f) (get-type fst #:infer #t #:default Univ))))
246-
(if (and ann-ty (not (Error? ann-ty)))
247-
ann-ty
248-
(apply Un (for/list ((dom (in-list dom*)) #:when (pair? dom)) (car dom)))))]
249-
[(ex* fst+)
250-
(if skip-dom?
251-
(values '() #f)
252-
(protect-domain fst-ty fst (build-source-location-list fst) ctc-cache))])
253-
(void (register-extra-defs! ex*))
254-
(if fst+ (cons fst+ check*) check*))))])
225+
(cond
226+
[(or (identifier? args)
227+
(null? args)
228+
(and (syntax? args) (null? (syntax-e args))))
229+
'()]
230+
[else
231+
(define-values (fst rst)
232+
(cond
233+
[(pair? args) (values (car args) (cdr args))]
234+
[(syntax? args)
235+
(let ([e (syntax-e args)]) (values (car e) (cdr e)))]
236+
[else
237+
(raise-syntax-error 'shallow-rewrite-top
238+
"#%plain-lambda formals"
239+
#'formals
240+
args)]))
241+
(define check*
242+
(let ([dom+ (for/fold ([acc '()]) ([dom (in-list dom*)])
243+
(if (pair? dom)
244+
(cons (cdr dom) acc)
245+
acc))])
246+
(protect-loop rst dom+)))
247+
(define fst-ty
248+
(let ([ann-ty (and (type-annotation fst #:infer #f)
249+
(get-type fst #:infer #t #:default Univ))])
250+
(if (and ann-ty (not (Error? ann-ty)))
251+
ann-ty
252+
(apply Un
253+
(for/list ([dom (in-list dom*)]
254+
#:when (pair? dom))
255+
(car dom))))))
256+
(define-values (ex* fst+)
257+
(if skip-dom?
258+
(values '() #f)
259+
(protect-domain fst-ty
260+
fst
261+
(build-source-location-list fst)
262+
ctc-cache)))
263+
(void (register-extra-defs! ex*))
264+
(if fst+
265+
(cons fst+ check*)
266+
check*)]))])
255267
(if (null? check-formal*)
256268
body+
257269
(cons
@@ -272,50 +284,62 @@
272284
;; no type
273285
(quasisyntax/loc formals [#,formals . #,body])]
274286
[else
287+
(define len (formals-length formals))
275288
(define matching-dom*
276-
(let ([len (formals-length formals)])
277-
(for/list ((dom (in-list all-dom*))
278-
#:when (= len (length dom)))
279-
dom)))
289+
(for/list ([dom (in-list all-dom*)]
290+
#:when (= len (length dom)))
291+
dom))
280292
(quasisyntax/loc stx
281293
[#,formals .
282294
#,(let* ([body+
283295
(copy-props (loop body #f trusted-fn*) body)]
284296
[check-formal*
285297
(let protect-loop ([args formals]
286298
[dom* matching-dom*])
287-
(if (or (identifier? args)
288-
(null? args)
289-
(and (syntax? args) (null? (syntax-e args))))
290-
'()
291-
(let*-values ([(fst rst)
292-
(cond
293-
[(pair? args)
294-
(values (car args) (cdr args))]
295-
[(syntax? args)
296-
(let ((e (syntax-e args)))
297-
(values (car e) (cdr e)))]
298-
[else
299-
(raise-syntax-error 'shallow-rewrite-top "#%plain-lambda formals" formals args)])]
300-
[(check*)
301-
(let ((dom+
302-
(for/fold ((acc '()))
303-
((dom (in-list dom*)))
304-
(if (pair? dom) (cons (cdr dom) acc) acc))))
305-
(protect-loop rst dom+))]
306-
[(fst-ty)
307-
(if (type-annotation fst #:infer #f)
308-
(get-type fst #:infer #t #:default Univ)
309-
(apply Un
310-
(for/fold ((acc '()))
311-
((dom (in-list dom*)))
312-
(if (pair? dom) (cons (car dom) acc) acc))))]
313-
[(ex* fst+)
314-
(if skip-dom?
315-
(values '() #f)
316-
(protect-domain fst-ty fst (build-source-location-list fst) ctc-cache))])
317-
(void (register-extra-defs! ex*))
318-
(if fst+ (cons fst+ check*) check*))))])
299+
(cond
300+
[(or (identifier? args)
301+
(null? args)
302+
(and (syntax? args) (null? (syntax-e args))))
303+
'()]
304+
[else
305+
(define-values (fst rst)
306+
(cond
307+
[(pair? args) (values (car args) (cdr args))]
308+
[(syntax? args)
309+
(let ([e (syntax-e args)])
310+
(values (car e) (cdr e)))]
311+
[else
312+
(raise-syntax-error 'shallow-rewrite-top
313+
"#%plain-lambda formals"
314+
formals
315+
args)]))
316+
(define check*
317+
(let ([dom+ (for/fold ([acc '()])
318+
([dom (in-list dom*)])
319+
(if (pair? dom)
320+
(cons (cdr dom) acc)
321+
acc))])
322+
(protect-loop rst dom+)))
323+
(define fst-ty
324+
(if (type-annotation fst #:infer #f)
325+
(get-type fst #:infer #t #:default Univ)
326+
(apply Un
327+
(for/fold ([acc '()])
328+
([dom (in-list dom*)])
329+
(if (pair? dom)
330+
(cons (car dom) acc)
331+
acc)))))
332+
(define-values (ex* fst+)
333+
(if skip-dom?
334+
(values '() #f)
335+
(protect-domain fst-ty
336+
fst
337+
(build-source-location-list fst)
338+
ctc-cache)))
339+
(void (register-extra-defs! ex*))
340+
(if fst+
341+
(cons fst+ check*)
342+
check*)]))])
319343
(if (null? check-formal*)
320344
body+
321345
(cons
@@ -415,19 +439,19 @@
415439
stx)
416440

417441
(define (maybe-add-typeof-expr new-stx old-stx)
418-
(let ((old-type (maybe-type-of old-stx)))
419-
(when old-type
420-
(add-typeof-expr new-stx old-type))))
442+
(define old-type (maybe-type-of old-stx))
443+
(when old-type
444+
(add-typeof-expr new-stx old-type)))
421445

422446
(define (maybe-add-test-position new-stx old-stx)
423447
(maybe-add-test-true new-stx old-stx)
424448
(maybe-add-test-false new-stx old-stx)
425449
(void))
426450

427451
(define (maybe-add-scoped-tvar new-stx old-stx)
428-
(let ([old-layer (lookup-scoped-tvar-layer old-stx)])
429-
(when old-layer
430-
(add-scoped-tvars new-stx old-layer))))
452+
(define old-layer (lookup-scoped-tvar-layer old-stx))
453+
(when old-layer
454+
(add-scoped-tvars new-stx old-layer)))
431455

432456
(define (maybe-add-test-true new-stx old-stx)
433457
(when (test-position-takes-true-branch old-stx)
@@ -449,20 +473,15 @@
449473

450474
(define (formals-fold init f stx)
451475
(let loop ((v stx))
452-
(if (or (identifier? v)
453-
(null? v)
454-
(and (syntax? v) (null? (syntax-e v))))
455-
init
456-
(let*-values (((fst rst)
457-
(cond
458-
[(pair? v)
459-
(values (car v) (cdr v))]
460-
[(syntax? v)
461-
(let ((e (syntax-e v)))
462-
(values (car e) (cdr e)))]
463-
[else
464-
(raise-syntax-error 'formals-fold "lambda formals" stx)])))
465-
(f (loop rst) fst)))))
476+
(cond
477+
[(or (identifier? v) (null? v) (and (syntax? v) (null? (syntax-e v)))) init]
478+
[else
479+
(define-values (fst rst)
480+
(cond
481+
[(pair? v) (values (car v) (cdr v))]
482+
[(syntax? v) (let ([e (syntax-e v)]) (values (car e) (cdr e)))]
483+
[else (raise-syntax-error 'formals-fold "lambda formals" stx)]))
484+
(f (loop rst) fst)])))
466485

467486
;; is-application? : Syntax -> Boolean
468487
;; Returns #true if `stx` is a function application (an app that may need dynamic checking)
@@ -629,12 +648,10 @@
629648
(λ (mpi)
630649
(hash-ref! cache mpi
631650
(λ () ;; Typed Racket always installs a `#%type-decl` submodule
632-
(let* ([mpi+ (module-path-index-join '(submod "." #%type-decl) mpi)])
633-
(parameterize ([current-namespace (make-base-namespace)])
634-
(with-handlers ([exn:fail:contract? (lambda (exn) #f)])
635-
(and mpi+
636-
(dynamic-require mpi+ #f)
637-
#t)))))))))
651+
(define mpi+ (module-path-index-join '(submod "." #%type-decl) mpi))
652+
(parameterize ([current-namespace (make-base-namespace)])
653+
(with-handlers ([exn:fail:contract? (lambda (exn) #f)])
654+
(and mpi+ (dynamic-require mpi+ #f) #t))))))))
638655

639656
(define (protect-domain dom-type dom-stx ctx ctc-cache)
640657
(define-values [extra-def* ctc-stx]

0 commit comments

Comments
 (0)