Skip to content

Automated Resyntax fixes #1449

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 17 commits into from
May 5, 2025
Merged

Automated Resyntax fixes #1449

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
17 commits
Select commit Hold shift + click to select a range
65e7f67
Fix 6 occurrences of `let-to-define`
resyntax-ci[bot] May 2, 2025
ce970a5
Fix 1 occurrence of `if-else-false-to-and`
resyntax-ci[bot] May 2, 2025
cf7cb3e
Fix 8 occurrences of `single-clause-match-to-match-define`
resyntax-ci[bot] May 2, 2025
d891305
Fix 3 occurrences of `zero-comparison-to-positive?`
resyntax-ci[bot] May 2, 2025
c9c5509
Fix 1 occurrence of `begin0-let-to-define-begin0`
resyntax-ci[bot] May 2, 2025
8c451c2
Fix 1 occurrence of `if-let-to-cond`
resyntax-ci[bot] May 2, 2025
aad59bd
Fix 1 occurrence of `if-x-else-x-to-and`
resyntax-ci[bot] May 2, 2025
8cdbe7a
Fix 2 occurrences of `define-simple-macro-to-define-syntax-parse-rule`
resyntax-ci[bot] May 2, 2025
c0f7441
Fix 1 occurrence of `inverted-unless`
resyntax-ci[bot] May 2, 2025
e40e358
Fix 3 occurrences of `cond-let-to-cond-define`
resyntax-ci[bot] May 2, 2025
78ac288
Fix 2 occurrences of `for/fold-with-conditional-body-to-when-keyword`
resyntax-ci[bot] May 2, 2025
33945c1
Fix 2 occurrences of `define-let-to-double-define`
resyntax-ci[bot] May 2, 2025
224e239
Fix 1 occurrence of `always-throwing-cond-to-when`
resyntax-ci[bot] May 2, 2025
ea59282
Fix 1 occurrence of `map-to-for`
resyntax-ci[bot] May 2, 2025
a26cf51
Fix 2 occurrences of `sort-with-keyed-comparator-to-sort-by-key`
resyntax-ci[bot] May 2, 2025
ec12a00
Fix 2 occurrences of `format-identity`
resyntax-ci[bot] May 2, 2025
8d26a34
Fix 1 occurrence of `for/fold-with-conditional-body-to-when-keyword`
resyntax-ci[bot] May 2, 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
55 changes: 28 additions & 27 deletions typed-racket-lib/typed-racket/private/shallow-rewrite.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -232,27 +232,29 @@
(cond
[(pair? args) (values (car args) (cdr args))]
[(syntax? args)
(let ([e (syntax-e args)]) (values (car e) (cdr e)))]
(define e (syntax-e args))
(values (car e) (cdr e))]
[else
(raise-syntax-error 'shallow-rewrite-top
"#%plain-lambda formals"
#'formals
args)]))
(define check*
(let ([dom+ (for/fold ([acc '()]) ([dom (in-list dom*)])
(if (pair? dom)
(cons (cdr dom) acc)
acc))])
Copy link
Member

Choose a reason for hiding this comment

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

Could this be a for/list?

Copy link
Member

Choose a reason for hiding this comment

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

cc @jackfirth

Copy link
Contributor

@jackfirth jackfirth May 6, 2025 •
edited
Loading

Choose a reason for hiding this comment

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

Such a rewrite would have to add a reverse in order to preserve ordering, so Resyntax would rewrite it to this:

(reverse
 (for/list ([dom (in-list dom*)]
            #:when (pair? dom))
   (cdr dom)))

I'm not sure that's a great idea since it adds two extra linear traversals over the resulting list, making the code slower.

Copy link
Member

Choose a reason for hiding this comment

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

We should have a for/reverse, clearly.

Copy link
Contributor

Choose a reason for hiding this comment

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

I'm not all that sure it comes up often enough to be warranted :p I think a lot of the time when the order of a list doesn't matter so using for/reverse would be viable, it would also be the case that just using an actually-unordered data structure like a set would be even better.

(let ([dom+ (for/fold ([acc '()])
([dom (in-list dom*)]
#:when (pair? dom))
(cons (cdr dom) acc))])
(protect-loop rst dom+)))
(define ann-ty
(and (type-annotation fst #:infer #f)
(get-type fst #:infer #t #:default Univ)))
(define fst-ty
(let ([ann-ty (and (type-annotation fst #:infer #f)
(get-type fst #:infer #t #:default Univ))])
(if (and ann-ty (not (Error? ann-ty)))
ann-ty
(apply Un
(for/list ([dom (in-list dom*)]
#:when (pair? dom))
(car dom))))))
(if (and ann-ty (not (Error? ann-ty)))
ann-ty
(apply Un
(for/list ([dom (in-list dom*)]
#:when (pair? dom))
(car dom)))))
(define-values (ex* fst+)
(if skip-dom?
(values '() #f)
Expand Down Expand Up @@ -306,29 +308,27 @@
(cond
[(pair? args) (values (car args) (cdr args))]
[(syntax? args)
(let ([e (syntax-e args)])
(values (car e) (cdr e)))]
(define e (syntax-e args))
(values (car e) (cdr e))]
Copy link
Member

Choose a reason for hiding this comment

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

There should be a function that does this.

[else
(raise-syntax-error 'shallow-rewrite-top
"#%plain-lambda formals"
formals
args)]))
(define check*
(let ([dom+ (for/fold ([acc '()])
([dom (in-list dom*)])
(if (pair? dom)
(cons (cdr dom) acc)
acc))])
(protect-loop rst dom+)))
(define dom+
(for/fold ([acc '()])
([dom (in-list dom*)]
#:when (pair? dom))
(cons (cdr dom) acc)))
(define check* (protect-loop rst dom+))
(define fst-ty
(if (type-annotation fst #:infer #f)
(get-type fst #:infer #t #:default Univ)
(apply Un
(for/fold ([acc '()])
([dom (in-list dom*)])
(if (pair? dom)
(cons (car dom) acc)
acc)))))
([dom (in-list dom*)]
#:when (pair? dom))
(cons (car dom) acc)))))
(define-values (ex* fst+)
(if skip-dom?
(values '() #f)
Expand Down Expand Up @@ -479,7 +479,8 @@
(define-values (fst rst)
(cond
[(pair? v) (values (car v) (cdr v))]
[(syntax? v) (let ([e (syntax-e v)]) (values (car e) (cdr e)))]
[(syntax? v) (define e (syntax-e v))
(values (car e) (cdr e))]
[else (raise-syntax-error 'formals-fold "lambda formals" stx)]))
(f (loop rst) fst)])))

Expand Down
19 changes: 9 additions & 10 deletions typed-racket-lib/typed-racket/private/type-annotation.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -122,16 +122,15 @@
(for/list ([stx (in-list stxs)]
[tcr (in-list tcrs)]
[a (in-list anns)])
(match tcr
[(tc-result: ty ps o)
(cond
[a
(check-type stx ty a)
(-tc-result a ps o)]
;; mutated variables get generalized, so that we don't
;; infer too small a type
[(is-var-mutated? stx) (-tc-result (generalize ty) ps o)]
[else (-tc-result ty ps o)])]))])]))]))
(match-define (tc-result: ty ps o) tcr)
(cond
[a
(check-type stx ty a)
(-tc-result a ps o)]
;; mutated variables get generalized, so that we don't
;; infer too small a type
[(is-var-mutated? stx) (-tc-result (generalize ty) ps o)]
[else (-tc-result ty ps o)]))])]))]))

;; check that e-type is compatible with ty in context of stx
;; otherwise, error
Expand Down
8 changes: 4 additions & 4 deletions typed-racket-lib/typed-racket/private/type-contract.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -830,10 +830,10 @@
(match p
[(TypeProp: o t)
(define sc (t->sc t bound-all-vars))
(cond
[(not (equal? flat-sym (get-max-contract-kind sc)))
(raise-user-error 'type->static-contract/shallow "proposition contract generation not supported for non-flat types")]
[else (is-flat-type/sc (obj->sc o) sc)])]
(unless (equal? flat-sym (get-max-contract-kind sc))
(raise-user-error 'type->static-contract/shallow
"proposition contract generation not supported for non-flat types"))
(is-flat-type/sc (obj->sc o) sc)]
[(NotTypeProp: o t)
(define sc (t->sc t bound-all-vars))
(unless (equal? flat-sym (get-max-contract-kind sc))
Expand Down
12 changes: 5 additions & 7 deletions typed-racket-lib/typed-racket/rep/base-union.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,8 @@
(app BaseUnion-bases bases)))])))

(define (BaseUnion-bases t)
(match t
[(BaseUnion: bbits nbits)
(cond
[(eqv? bbits 0) (nbits->base-types nbits)]
[(eqv? nbits 0) (bbits->base-types bbits)]
[else (append (bbits->base-types bbits)
(nbits->base-types nbits))])]))
(match-define (BaseUnion: bbits nbits) t)
(cond
[(eqv? bbits 0) (nbits->base-types nbits)]
[(eqv? nbits 0) (bbits->base-types bbits)]
[else (append (bbits->base-types bbits) (nbits->base-types nbits))]))
2 changes: 1 addition & 1 deletion typed-racket-lib/typed-racket/rep/core-rep.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,7 @@
(-> Result? Result?)
(match-define (Result: type propset optobject n-existentials) result)
(cond
[(> n-existentials 0)
[(positive? n-existentials)
(define syms (hash-ref type-var-name-table result (build-list n-existentials (lambda _ (gensym)))))
(define vars (map make-F syms))
(make-Result (instantiate-type type vars) (instantiate-propset propset vars) optobject n-existentials)]
Expand Down
8 changes: 3 additions & 5 deletions typed-racket-lib/typed-racket/rep/free-ids.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,11 +69,9 @@
(cond
[(member x seen free-identifier=?) (cons x seen)]
[else
(begin0
(let ([seen+x (cons x seen)])
(for/or ([neighbor (in-list (cdr (assoc x deps free-identifier=?)))])
(and (not (member neighbor visited free-identifier=?))
(visit neighbor seen+x))))
(define seen+x (cons x seen))
(begin0 (for/or ([neighbor (in-list (cdr (assoc x deps free-identifier=?)))])
(and (not (member neighbor visited free-identifier=?)) (visit neighbor seen+x)))
(set! visited (cons x visited)))]))
(match (for/or ([entry (in-list deps)])
(visit (car entry) '()))
Expand Down
12 changes: 4 additions & 8 deletions typed-racket-lib/typed-racket/rep/free-variance.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -123,18 +123,14 @@
(for/fold ([hash (hasheq)]
[computed null])
([frees (in-list freess)])
(match frees
[(combined-frees new-hash new-computed)
(values (combine-hashes (list hash new-hash))
(append new-computed computed))])))
(match-define (combined-frees new-hash new-computed) frees)
(values (combine-hashes (list hash new-hash)) (append new-computed computed))))
(combined-frees hash computed))


(define (free-vars-remove frees name)
(match frees
[(combined-frees hash computed)
(combined-frees (hash-remove hash name)
(map (λ (v) (remove-frees v name)) computed))]))
(match-define (combined-frees hash computed) frees)
(combined-frees (hash-remove hash name) (map (λ (v) (remove-frees v name)) computed)))

;;
(define (free-vars-names vars)
Expand Down
17 changes: 7 additions & 10 deletions typed-racket-lib/typed-racket/rep/object-rep.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -268,10 +268,10 @@
[(list (? exact-integer? coeff) (? Path? p))
(values c (terms-set ts p (+ coeff (terms-ref ts p))))]
[(list (? exact-integer? coeff) (? name-ref/c nm))
(let ([p (-id-path nm)])
(if (Empty? nm)
(values c ts)
(values c (terms-set ts p (+ coeff (terms-ref ts p))))))]
(define p (-id-path nm))
(if (Empty? nm)
(values c ts)
(values c (terms-set ts p (+ coeff (terms-ref ts p)))))]
[(? exact-integer? new-const)
(values (+ new-const c) ts)]
[(LExp: c* ts*)
Expand Down Expand Up @@ -313,9 +313,7 @@
(-> OptObject? (or/c #f exact-integer?))
(match l
[(LExp: c terms)
(if (hash-empty? terms)
c
#f)]
(and (hash-empty? terms) c)]
[_ #f]))

(define/cond-contract (in-LExp? obj l)
Expand Down Expand Up @@ -388,6 +386,5 @@
(make-LExp* (+ c1 c2) (terms-add terms1 terms2))]))

(define (add-path-to-lexp p l)
(match l
[(LExp: const terms)
(make-LExp* const (terms-set terms p (add1 (terms-ref terms p))))]))
(match-define (LExp: const terms) l)
(make-LExp* const (terms-set terms p (add1 (terms-ref terms p)))))
3 changes: 1 addition & 2 deletions typed-racket-lib/typed-racket/rep/prop-rep.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -143,8 +143,7 @@
[#:for-each (f) (for-each f ps)]
[#:custom-constructor/contract
(-> (listof (or/c TypeProp? NotTypeProp? LeqProp?)) OrProp?)
(let ([ps (sort ps (λ (p q) (unsafe-fx<= (eq-hash-code p)
(eq-hash-code q))))])
(let ([ps (sort ps unsafe-fx<= #:key eq-hash-code)])
(intern-single-ref!
orprop-intern-table
ps
Expand Down
2 changes: 1 addition & 1 deletion typed-racket-lib/typed-racket/rep/rep-switch.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@
(~var clause (switch-clause #'(pre-args ...) #'arg #'(post-args ...))) ...
[(~datum else:) . default])
(define name-symbols (map syntax->datum (syntax->list #'(clause.name ...))))
(unless (not (null? name-symbols))
(when (null? name-symbols)
(raise-syntax-error 'define-switch "switch cannot be null" stx))
(define sorted-name-symbols (sort name-symbols symbol<?))
(unless (eq? (first name-symbols) (first sorted-name-symbols))
Expand Down
18 changes: 7 additions & 11 deletions typed-racket-lib/typed-racket/rep/rep-utils.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,9 +117,7 @@
;; NOTE: the #:construct expression is only run if there
;; is no interned copy, so we should avoid unnecessary
;; allocation w/ this approach
(define-simple-macro (intern-single-ref! table-exp:expr
key-exp:expr
#:construct val-exp:expr)
(define-syntax-parse-rule (intern-single-ref! table-exp:expr key-exp:expr #:construct val-exp:expr)
(let ([table table-exp])
(define key key-exp)
(define intern-box (hash-ref table key #f))
Expand All @@ -132,13 +130,11 @@

;; fetches an interned Rep based on the given _two_ keys
;; see 'intern-single-ref!'
(define-simple-macro (intern-double-ref! table:id
key-exp1:expr
key-exp2:expr
#:construct val-exp:expr)
(intern-single-ref! (hash-ref! table key-exp1 make-hash)
key-exp2
#:construct val-exp))
(define-syntax-parse-rule (intern-double-ref! table:id
key-exp1:expr
key-exp2:expr
#:construct val-exp:expr)
(intern-single-ref! (hash-ref! table key-exp1 make-hash) key-exp2 #:construct val-exp))



Expand Down Expand Up @@ -398,7 +394,7 @@
;; singletons cannot have fields or #:no-provide
(when (and (attribute singleton)
(or (attribute no-provide?-kw)
(> (length (syntax->list #'flds)) 0)))
(positive? (length (syntax->list #'flds)))))
(raise-syntax-error 'def-rep "singletons cannot have fields or the #:no-provide option"
#'var))
(when (and (attribute base?)
Expand Down
6 changes: 3 additions & 3 deletions typed-racket-lib/typed-racket/rep/type-rep.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1161,8 +1161,8 @@
(match ts
[(list) (-refine Univ prop)]
[(list t) (-refine t prop)]
[_ (let ([t (make-Intersection ts -tt elems)])
(-refine t prop))])]
[_ (define t (make-Intersection ts -tt elems))
(-refine t prop)])]
[(cons arg args)
(match arg
[(Univ:) (loop ts elems prop args)]
Expand Down Expand Up @@ -1813,7 +1813,7 @@

;; sorts the given field of a Row by the member name
(define (sort-row-clauses clauses)
(sort clauses (λ (x y) (symbol<? (car x) (car y)))))
(sort clauses symbol<? #:key car))

(define-match-expander Class:*
(λ (stx)
Expand Down
4 changes: 2 additions & 2 deletions typed-racket-lib/typed-racket/typecheck/error-message.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,9 +80,9 @@
(unless object?
(when (and (F? row) (not (F? row*)))
(type-mismatch (format "Class with row variable `~a'" row)
(format "Class with no row variable")))
"Class with no row variable"))
(when (and (F? row*) (not (F? row)))
(type-mismatch (format "Class with no row variable")
(type-mismatch "Class with no row variable"
(format "Class with row variable `~a'" row*)))
(when (and (F? row) (F? row) (not (equal? row row*)))
(type-mismatch (format "Class with row variable `~a'" row)
Expand Down
11 changes: 5 additions & 6 deletions typed-racket-lib/typed-racket/typecheck/renamer.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,9 +43,8 @@
;;
;; The syntax-transforming check is for unit tests
(define (un-rename id)
(if (syntax-transforming?)
(let-values (((binding new-id) (syntax-local-value/immediate id (lambda () (values #f #f)))))
(if (typed-renaming? binding)
new-id
id))
id))
(cond
[(syntax-transforming?)
(define-values (binding new-id) (syntax-local-value/immediate id (lambda () (values #f #f))))
(if (typed-renaming? binding) new-id id)]
[else id]))
Loading