From 21784fd6b92357ba62cbf8b5197762af2616cc89 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:11 +0000 Subject: [PATCH 01/18] Fix 2 occurrences of `define-simple-macro-to-define-syntax-parse-rule` The `define-simple-macro` form has been renamed to `define-syntax-parse-rule`. --- typed-racket-lib/typed-racket/rep/rep-utils.rkt | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/rep-utils.rkt b/typed-racket-lib/typed-racket/rep/rep-utils.rkt index 1a01e562a..55e8407d8 100644 --- a/typed-racket-lib/typed-racket/rep/rep-utils.rkt +++ b/typed-racket-lib/typed-racket/rep/rep-utils.rkt @@ -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)) @@ -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)) From 63a7fe11242c522e2fde1c5d5b282c8cd696250f Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:11 +0000 Subject: [PATCH 02/18] Fix 2 occurrences of `zero-comparison-to-positive?` This expression is equivalent to calling the `positive?` predicate. --- typed-racket-lib/typed-racket/rep/core-rep.rkt | 2 +- typed-racket-lib/typed-racket/rep/rep-utils.rkt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/core-rep.rkt b/typed-racket-lib/typed-racket/rep/core-rep.rkt index 3e32e576f..c3178cf4d 100644 --- a/typed-racket-lib/typed-racket/rep/core-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/core-rep.rkt @@ -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)] diff --git a/typed-racket-lib/typed-racket/rep/rep-utils.rkt b/typed-racket-lib/typed-racket/rep/rep-utils.rkt index 55e8407d8..18bd1027b 100644 --- a/typed-racket-lib/typed-racket/rep/rep-utils.rkt +++ b/typed-racket-lib/typed-racket/rep/rep-utils.rkt @@ -394,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?) From 60a139954282936d0d0ff0bf921d2116e03280f5 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:11 +0000 Subject: [PATCH 03/18] Fix 1 occurrence of `syntax-disarm-migration` The `syntax-disarm` function is a legacy function that does nothing. --- typed-racket-lib/typed/private/rewriter.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/typed-racket-lib/typed/private/rewriter.rkt b/typed-racket-lib/typed/private/rewriter.rkt index 7bd43150d..8c40bfe27 100644 --- a/typed-racket-lib/typed/private/rewriter.rkt +++ b/typed-racket-lib/typed/private/rewriter.rkt @@ -7,7 +7,7 @@ (define-for-syntax (rewrite stx tbl from) (define (rw stx) - (syntax-parse (syntax-disarm stx code-insp) #:literal-sets (kernel-literals) + (syntax-parse stx #:literal-sets (kernel-literals) [i:identifier (dict-ref tbl #'i #'i)] ;; no expressions here From da8c553bb3ae56ad29bdcb895413daa65840c828 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:11 +0000 Subject: [PATCH 04/18] Fix 5 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- .../typed-racket/rep/object-rep.rkt | 8 +- .../typed-racket/rep/type-rep.rkt | 4 +- .../typed-racket/typed-reader.rkt | 109 ++++++++++-------- 3 files changed, 67 insertions(+), 54 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/object-rep.rkt b/typed-racket-lib/typed-racket/rep/object-rep.rkt index 418563b55..68fe85e47 100644 --- a/typed-racket-lib/typed-racket/rep/object-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/object-rep.rkt @@ -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*) diff --git a/typed-racket-lib/typed-racket/rep/type-rep.rkt b/typed-racket-lib/typed-racket/rep/type-rep.rkt index b412e09e8..2733b6220 100644 --- a/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -1154,8 +1154,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)] diff --git a/typed-racket-lib/typed-racket/typed-reader.rkt b/typed-racket-lib/typed-racket/typed-reader.rkt index 7cb6e9340..80e19ff95 100644 --- a/typed-racket-lib/typed-racket/typed-reader.rkt +++ b/typed-racket-lib/typed-racket/typed-reader.rkt @@ -8,61 +8,74 @@ (define (skip-whitespace port) ;; Skips whitespace characters, sensitive to the current ;; readtable's definition of whitespace - (let ([ch (peek-char port)]) - (unless (eof-object? ch) - ;; Consult current readtable: - (let-values ([(like-ch/sym proc dispatch-proc) - (readtable-mapping (current-readtable) ch)]) - ;; If like-ch/sym is whitespace, then ch is whitespace - (when (and (char? like-ch/sym) - (char-whitespace? like-ch/sym)) - (read-char port) - (skip-whitespace port)))))) + (define ch (peek-char port)) + (unless (eof-object? ch) + ;; Consult current readtable: + (let-values ([(like-ch/sym proc dispatch-proc) (readtable-mapping (current-readtable) ch)]) + ;; If like-ch/sym is whitespace, then ch is whitespace + (when (and (char? like-ch/sym) (char-whitespace? like-ch/sym)) + (read-char port) + (skip-whitespace port))))) (define (skip-comments read-one port src) ;; Recursive read, but skip comments and detect EOF (let loop () - (let ([v (read-one)]) - (cond - [(special-comment? v) (loop)] - [(eof-object? v) - (let-values ([(l c p) (port-next-location port)]) - (raise-read-eof-error "unexpected EOF in type annotation" src l c p 1))] - [else v])))) + (define v (read-one)) + (cond + [(special-comment? v) (loop)] + [(eof-object? v) + (let-values ([(l c p) (port-next-location port)]) + (raise-read-eof-error "unexpected EOF in type annotation" src l c p 1))] + [else v]))) (define (parse port read-one src) (skip-whitespace port) - (let ([name (read-one)]) - (begin0 - (begin (skip-whitespace port) - (let ([next (read-one)]) - (case (syntax-e next) - ;; type annotation - [(:) (skip-whitespace port) - (type-label-property name (syntax->datum (read-one)))] - [(::) (skip-whitespace port) - (datum->syntax name `(ann ,name : ,(read-one)))] - [(@) (let ([elems (let loop ([es '()]) - (skip-whitespace port) - (if (equal? #\} (peek-char port)) - (reverse es) - (loop (cons (read-one) es))))]) - (datum->syntax name `(inst ,name : ,@elems)))] - ;; arbitrary property annotation - [(PROP) (skip-whitespace port) - (let* ([prop-name (syntax-e (read-one))]) - (skip-whitespace port) - (syntax-property name prop-name (read-one)))] - ;; otherwise error - [else - (let-values ([(l c p) (port-next-location port)]) - (raise-read-error (format "typed expression ~a must be followed by :, ::, or @" - (syntax->datum name)) src l c p 1))]))) - (skip-whitespace port) - (let ([c (read-char port)]) - (unless (equal? #\} c) - (let-values ([(l c p) (port-next-location port)]) - (raise-read-error (format "typed expression ~a not properly terminated" (syntax->datum name)) src l c p 1))))))) + (define name (read-one)) + (begin0 (begin + (skip-whitespace port) + (let ([next (read-one)]) + (case (syntax-e next) + ;; type annotation + [(:) + (skip-whitespace port) + (type-label-property name (syntax->datum (read-one)))] + [(::) + (skip-whitespace port) + (datum->syntax name `(ann ,name : ,(read-one)))] + [(@) + (let ([elems (let loop ([es '()]) + (skip-whitespace port) + (if (equal? #\} (peek-char port)) + (reverse es) + (loop (cons (read-one) es))))]) + (datum->syntax name `(inst ,name : ,@elems)))] + ;; arbitrary property annotation + [(PROP) + (skip-whitespace port) + (let* ([prop-name (syntax-e (read-one))]) + (skip-whitespace port) + (syntax-property name prop-name (read-one)))] + ;; otherwise error + [else + (let-values ([(l c p) (port-next-location port)]) + (raise-read-error (format "typed expression ~a must be followed by :, ::, or @" + (syntax->datum name)) + src + l + c + p + 1))]))) + (skip-whitespace port) + (let ([c (read-char port)]) + (unless (equal? #\} c) + (let-values ([(l c p) (port-next-location port)]) + (raise-read-error (format "typed expression ~a not properly terminated" + (syntax->datum name)) + src + l + c + p + 1)))))) (define parse-id-type (case-lambda From 583a1e38923d0037501813226eb24dbc3766cd5a Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 05/18] Fix 2 occurrences of `if-else-false-to-and` This `if` expression can be refactored to an equivalent expression using `and`. --- typed-racket-lib/typed-racket/base-env/annotate-classes.rkt | 2 +- typed-racket-lib/typed-racket/rep/object-rep.rkt | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt b/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt index d93e2b96e..90f2f5ffd 100644 --- a/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt +++ b/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt @@ -169,7 +169,7 @@ #:with ty #'t)) (define-splicing-syntax-class optional-standalone-annotation (pattern (~optional a:standalone-annotation) - #:attr ty (if (attribute a) #'a.ty #f))) + #:attr ty (and (attribute a) #'a.ty))) (define-syntax-class type-variables #:attributes ((vars 1)) diff --git a/typed-racket-lib/typed-racket/rep/object-rep.rkt b/typed-racket-lib/typed-racket/rep/object-rep.rkt index 68fe85e47..4af88b394 100644 --- a/typed-racket-lib/typed-racket/rep/object-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/object-rep.rkt @@ -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) From f8d6c9dd6edfa8582aab0241347784d37db188a6 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 06/18] Fix 15 occurrences of `single-clause-match-to-match-define` This `match` expression can be simplified using `match-define`. --- .../typed-racket/rep/base-union.rkt | 12 +- .../typed-racket/rep/free-variance.rkt | 12 +- .../typed-racket/rep/object-rep.rkt | 5 +- .../static-contracts/combinators/control.rkt | 31 ++--- .../combinators/dep-function.rkt | 107 +++++++++--------- .../static-contracts/combinators/prefab.rkt | 42 +++---- 6 files changed, 94 insertions(+), 115 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/base-union.rkt b/typed-racket-lib/typed-racket/rep/base-union.rkt index c68b8cdb2..bdcffa2c7 100644 --- a/typed-racket-lib/typed-racket/rep/base-union.rkt +++ b/typed-racket-lib/typed-racket/rep/base-union.rkt @@ -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))])) diff --git a/typed-racket-lib/typed-racket/rep/free-variance.rkt b/typed-racket-lib/typed-racket/rep/free-variance.rkt index 7a97a12c6..2d16803c1 100644 --- a/typed-racket-lib/typed-racket/rep/free-variance.rkt +++ b/typed-racket-lib/typed-racket/rep/free-variance.rkt @@ -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) diff --git a/typed-racket-lib/typed-racket/rep/object-rep.rkt b/typed-racket-lib/typed-racket/rep/object-rep.rkt index 4af88b394..d9b1e3212 100644 --- a/typed-racket-lib/typed-racket/rep/object-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/object-rep.rkt @@ -386,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))))) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt index 0b35fc476..7eec8f2ac 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt @@ -24,14 +24,12 @@ (pt-seq-map f (combinator-args v)) (void)) (define (sc->contract v f) - (match v - [(prompt-tag-combinator (pt-seq vals call-cc)) - (with-syntax ([(vals-stx ...) (map f vals)] - [(call-cc-stx ...) - (if call-cc - #`(#:call/cc (values #,@(map f call-cc))) - empty)]) - #'(prompt-tag/c vals-stx ... call-cc-stx ...))])) + (match-define (prompt-tag-combinator (pt-seq vals call-cc)) v) + (with-syntax ([(vals-stx ...) (map f vals)] + [(call-cc-stx ...) (if call-cc + #`(#:call/cc (values #,@(map f call-cc))) + empty)]) + #'(prompt-tag/c vals-stx ... call-cc-stx ...))) (define (sc->constraints v f) (merge-restricts* 'chaperone (map f (pt-seq->list (combinator-args v)))))]) @@ -52,16 +50,11 @@ (define (pt-seq-map f seq) - (match seq - [(pt-seq vals call-cc) - (define (f* a) (f a 'invariant)) - (pt-seq - (map f* vals) - (and call-cc (map f* call-cc)))])) + (match-define (pt-seq vals call-cc) seq) + (define (f* a) + (f a 'invariant)) + (pt-seq (map f* vals) (and call-cc (map f* call-cc)))) (define (pt-seq->list seq) - (match seq - [(pt-seq vals call-cc) - (append - vals - (or call-cc empty))])) + (match-define (pt-seq vals call-cc) seq) + (append vals (or call-cc empty))) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt index 9a819f23c..5d7bbcbc9 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt @@ -25,64 +25,63 @@ #:property prop:combinator-name "dep->/sc" #:methods gen:sc [(define (sc->contract v rec) - (match v - [(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) - (with-syntax ([(id ...) ids] - [(c ...) (for/list ([d/sc (in-list dom/scs)] - [dep-ids (in-list dom-deps)]) - (cond - [(not (null? dep-ids)) - (parameterize ([static-contract-may-contain-free-ids? #t]) - (rec d/sc))] - [else (rec d/sc)]))] - [(dep ...) dom-deps] - [(r-deps ...) rng-deps] - [(p-deps ...) pre-deps]) - #`(->i ([id dep c] ...) - #,@(cond - [(not pre) #'()] - [else #`(#:pre (p-deps ...) - #,(cond - [(not (null? pre-deps)) - (parameterize ([static-contract-may-contain-free-ids? #t]) - (rec pre))] - [else (rec pre)]))]) - #,(cond - [(and typed-side? (andmap any/sc? rng-deps)) #'any] - [(null? rng-deps) - #`[_ () (values #,@(map rec rng/scs))]] - [else - (parameterize ([static-contract-may-contain-free-ids? #t]) - #`[_ (r-deps ...) (values #,@(map rec rng/scs))])])))])) + (match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v) + (with-syntax ([(id ...) ids] + [(c ...) (for/list ([d/sc (in-list dom/scs)] + [dep-ids (in-list dom-deps)]) + (cond + [(not (null? dep-ids)) + (parameterize ([static-contract-may-contain-free-ids? #t]) + (rec d/sc))] + [else (rec d/sc)]))] + [(dep ...) dom-deps] + [(r-deps ...) rng-deps] + [(p-deps ...) pre-deps]) + #`(->i ([id dep c] ...) + #,@(cond + [(not pre) #'()] + [else + #`(#:pre (p-deps ...) + #,(cond + [(not (null? pre-deps)) + (parameterize ([static-contract-may-contain-free-ids? #t]) + (rec pre))] + [else (rec pre)]))]) + #,(cond + [(and typed-side? (andmap any/sc? rng-deps)) #'any] + [(null? rng-deps) #`[_ () (values #,@(map rec rng/scs))]] + [else + (parameterize ([static-contract-may-contain-free-ids? #t]) + #`[_ (r-deps ...) (values #,@(map rec rng/scs))])])))) (define (sc-map v f) - (match v - [(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) - (->i/sc typed-side? - ids - (for/list ([d/sc (in-list dom/scs)]) - (f d/sc 'contravariant)) - dom-deps - (and pre (f pre 'contravariant)) - pre-deps - (for/list ([r/sc (in-list rng/scs)]) - (f r/sc 'covariant)) - rng-deps)])) + (match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v) + (->i/sc typed-side? + ids + (for/list ([d/sc (in-list dom/scs)]) + (f d/sc 'contravariant)) + dom-deps + (and pre (f pre 'contravariant)) + pre-deps + (for/list ([r/sc (in-list rng/scs)]) + (f r/sc 'covariant)) + rng-deps)) (define (sc-traverse v f) - (match v - [(->i/sc _ _ dom/scs _ pre _ rng/scs _) - (for ([d/sc (in-list dom/scs)]) - (f d/sc 'contravariant)) - (when pre (f pre 'contravariant)) - (for ([r/sc (in-list rng/scs)]) - (f r/sc 'covariant))])) + (match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v) + (for ([d/sc (in-list dom/scs)]) + (f d/sc 'contravariant)) + (when pre + (f pre 'contravariant)) + (for ([r/sc (in-list rng/scs)]) + (f r/sc 'covariant))) (define (sc-terminal-kind v) 'impersonator) (define (sc->constraints v f) - (match v - [(->i/sc _ _ dom/scs _ pre _ rng/scs _) - (merge-restricts* 'impersonator - (append (if pre (list (f pre)) (list)) - (map f rng/scs) - (map f dom/scs)))]))]) + (match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v) + (merge-restricts* 'impersonator + (append (if pre + (list (f pre)) + (list)) + (map f rng/scs) + (map f dom/scs))))]) (require-for-cond-contract "proposition.rkt") diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/prefab.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/prefab.rkt index c167925ad..c407981fd 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/prefab.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/prefab.rkt @@ -23,33 +23,27 @@ #:property prop:combinator-name "prefab/sc" #:methods gen:sc [(define (sc-map v f) - (match v - [(prefab-combinator args key field-mutability) - (prefab-combinator (map (λ (a mut?) (f a (if mut? 'invariant 'covariant))) - args - field-mutability) - key - field-mutability)])) + (match-define (prefab-combinator args key field-mutability) v) + (prefab-combinator + (map (λ (a mut?) (f a (if mut? 'invariant 'covariant))) args field-mutability) + key + field-mutability)) (define (sc-traverse v f) - (match v - [(prefab-combinator args key field-mutability) - (for-each (λ (a mut?) (f a (if mut? 'invariant 'covariant))) - args - field-mutability) - (void)])) + (match-define (prefab-combinator args key field-mutability) v) + (for-each (λ (a mut?) (f a (if mut? 'invariant 'covariant))) args field-mutability) + (void)) (define (sc->contract v f) - (match v - [(prefab-combinator args key _) - #`(prefab/c (quote #,(abbreviate-prefab-key key)) #,@(map f args))])) + (match-define (prefab-combinator args key _) v) + #`(prefab/c (quote #,(abbreviate-prefab-key key)) #,@(map f args))) (define (sc->constraints v f) - (match v - [(prefab-combinator args _ field-mutability) - (merge-restricts* - (if (ormap values field-mutability) 'chaperone 'flat) - (map (λ (a mut?) - (if (not mut?) (add-constraint (f a) 'chaperone) (f a))) - args - field-mutability))]))]) + (match-define (prefab-combinator args _ field-mutability) v) + (merge-restricts* (if (ormap values field-mutability) 'chaperone 'flat) + (map (λ (a mut?) + (if (not mut?) + (add-constraint (f a) 'chaperone) + (f a))) + args + field-mutability)))]) (define (prefab/sc key fields) (prefab-combinator fields key (prefab-key->field-mutability key))) From 84dc3456973be4e8ddc58dfeb91fa2f1ef24096a Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 07/18] Fix 2 occurrences of `map-to-for` This `map` operation can be replaced with a `for/list` loop. --- typed-racket-lib/typed-racket/base-env/unit-prims.rkt | 8 ++------ typed-racket-test/performance/infer-timing.rkt | 6 ++---- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/typed-racket-lib/typed-racket/base-env/unit-prims.rkt b/typed-racket-lib/typed-racket/base-env/unit-prims.rkt index f647bc194..8f2f7f2bb 100644 --- a/typed-racket-lib/typed-racket/base-env/unit-prims.rkt +++ b/typed-racket-lib/typed-racket/base-env/unit-prims.rkt @@ -133,12 +133,8 @@ ;; in the signature, this is needed to typecheck define-values/invoke-unit forms (define-for-syntax (imports/members sig-id) (define-values (_1 imp-mem _2 _3) (signature-members sig-id sig-id)) - #`(#,sig-id #,@(map (lambda (id) - (local-expand - id - (syntax-local-context) - (kernel-form-identifier-list))) - imp-mem))) + #`(#,sig-id #,@(for/list ([id (in-list imp-mem)]) + (local-expand id (syntax-local-context) (kernel-form-identifier-list))))) ;; Given a list of signature specs ;; Processes each signature spec to determine the variables exported diff --git a/typed-racket-test/performance/infer-timing.rkt b/typed-racket-test/performance/infer-timing.rkt index 72e09b02b..3176cd6a2 100644 --- a/typed-racket-test/performance/infer-timing.rkt +++ b/typed-racket-test/performance/infer-timing.rkt @@ -64,10 +64,8 @@ ;; once we have a set of props that are true/false based on reaching ;; a certain point, this will be more useful (define (fx-from-cases . cases) - (apply from-cases (map (lambda (x) - (add-unconditional-prop-all-args - x -Fixnum)) - (flatten cases)))) + (apply from-cases (for/list ([x (in-list (flatten cases))]) + (add-unconditional-prop-all-args x -Fixnum)))) (define (binop t [r t]) (t t . -> . r)) From c6f5a281168309208d160bfd6ece26e0dfd8a354 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 08/18] Fix 1 occurrence of `define-lambda-to-define` The `define` form supports a shorthand for defining functions. --- typed-racket-test/performance/infer-timing.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/typed-racket-test/performance/infer-timing.rkt b/typed-racket-test/performance/infer-timing.rkt index 3176cd6a2..c095da01e 100644 --- a/typed-racket-test/performance/infer-timing.rkt +++ b/typed-racket-test/performance/infer-timing.rkt @@ -405,7 +405,8 @@ (displayln `(big ,n)) (define ty-list (append ts ts)) (collect-garbage) (collect-garbage) (collect-garbage) - (define run (λ () (void (bigcall n ty-list)))) + (define (run) + (void (bigcall n ty-list))) (cond [hsbencher (define-values (vs t r gc) (time-apply run null)) From 5f1257ecd6252b7cfbd1d5cd45f244088d806406 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 09/18] Fix 1 occurrence of `provide-deduplication` Providing the same identifier multiple times is unnecessary. --- typed-racket-lib/typed-racket/base-env/base-structs.rkt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/typed-racket-lib/typed-racket/base-env/base-structs.rkt b/typed-racket-lib/typed-racket/base-env/base-structs.rkt index 4ac4cd298..d9deff1c8 100644 --- a/typed-racket-lib/typed-racket/base-env/base-structs.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-structs.rkt @@ -11,7 +11,11 @@ (require (for-template racket/base (prefix-in k: '#%kernel))) -(provide initialize-structs -Date -Srcloc -Date -Arity-At-Least -Exn) +(provide initialize-structs + -Date + -Srcloc + -Arity-At-Least + -Exn) (define-syntax define-hierarchy (syntax-rules (define-hierarchy) From 57862b32e38caff5ab614fb57f257a785993e4a0 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 10/18] Fix 1 occurrence of `if-begin-to-cond` Using `cond` instead of `if` here makes `begin` unnecessary --- typed-racket-lib/typed-racket/tc-setup.rkt | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/typed-racket-lib/typed-racket/tc-setup.rkt b/typed-racket-lib/typed-racket/tc-setup.rkt index 197f2ea2d..6f2b123f1 100644 --- a/typed-racket-lib/typed-racket/tc-setup.rkt +++ b/typed-racket-lib/typed-racket/tc-setup.rkt @@ -36,15 +36,15 @@ ;; types are enforced (not no-check etc.), ;; PLT_TR_NO_OPTIMIZE is not set, and the ;; current code inspector has sufficient privileges - (if (and (optimize?) - (memq (current-type-enforcement-mode) (list deep shallow)) - (not (getenv "PLT_TR_NO_OPTIMIZE")) - (authorized-code-inspector?)) - (begin - (do-time "Starting optimizer") - (begin0 (stx-map optimize-top body) - (do-time "Optimized"))) - body)) + (cond + [(and (optimize?) + (memq (current-type-enforcement-mode) (list deep shallow)) + (not (getenv "PLT_TR_NO_OPTIMIZE")) + (authorized-code-inspector?)) + (do-time "Starting optimizer") + (begin0 (stx-map optimize-top body) + (do-time "Optimized"))] + [else body])) (define (maybe-shallow-rewrite body-stx ctc-cache) (case (current-type-enforcement-mode) From 651bd6898ed11a270f063274ee41d8a3bc831ff9 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 11/18] Fix 1 occurrence of `begin0-let-to-define-begin0` The `let` expression in this `begin0` form can be extracted into the surrounding definition context. --- typed-racket-lib/typed-racket/rep/free-ids.rkt | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/free-ids.rkt b/typed-racket-lib/typed-racket/rep/free-ids.rkt index f069dd39a..6c8235874 100644 --- a/typed-racket-lib/typed-racket/rep/free-ids.rkt +++ b/typed-racket-lib/typed-racket/rep/free-ids.rkt @@ -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) '())) From 3575e85ce22286686c328bdadc780d7fc5e70b68 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 12/18] Fix 1 occurrence of `case-lambda-with-single-case-to-lambda` This `case-lambda` form only has one case. Use a regular lambda instead. --- typed-racket-lib/typed-racket/typed-reader.rkt | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/typed-racket-lib/typed-racket/typed-reader.rkt b/typed-racket-lib/typed-racket/typed-reader.rkt index 80e19ff95..d033d488c 100644 --- a/typed-racket-lib/typed-racket/typed-reader.rkt +++ b/typed-racket-lib/typed-racket/typed-reader.rkt @@ -78,16 +78,12 @@ 1)))))) (define parse-id-type - (case-lambda - [(ch port src line col pos) - ;; `read-syntax' mode - (datum->syntax - #f - (parse port - (lambda () (read-syntax src port )) - src) - (let-values ([(l c p) (port-next-location port)]) - (list src line col pos (and pos (- p pos)))))])) + (λ (ch port src line col pos) + ;; `read-syntax' mode + (datum->syntax #f + (parse port (lambda () (read-syntax src port)) src) + (let-values ([(l c p) (port-next-location port)]) + (list src line col pos (and pos (- p pos))))))) (define (readtable) ; don't install the reader macro if a dispatch macro on the open brace has already been installed From 3f21958eb510bbc3f9c9b8a303824738b105ac72 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 13/18] Fix 1 occurrence of `define-values-values-to-define` This use of `define-values` is unnecessary. --- typed-racket-lib/typed-racket/base-env/annotate-classes.rkt | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt b/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt index 90f2f5ffd..3b8d378fb 100644 --- a/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt +++ b/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt @@ -330,10 +330,8 @@ (define-values (all-mand-tys all-opt-tys) (cond [kw-property - (define-values (mand-kw-set opt-kw-set) - (values - (list->set (lambda-kws-mand kw-property)) - (list->set (lambda-kws-opt kw-property)))) + (define mand-kw-set (list->set (lambda-kws-mand kw-property))) + (define opt-kw-set (list->set (lambda-kws-opt kw-property))) (define-values (mand-tys^ opt-kw^) (partition (part-pred opt-kw-set) From f2601c599a2659c8c46c5d9d31b7c73787245b74 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 14/18] Fix 1 occurrence of `inverted-unless` This negated `unless` expression can be replaced by a `when` expression. --- typed-racket-lib/typed-racket/rep/rep-switch.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/typed-racket-lib/typed-racket/rep/rep-switch.rkt b/typed-racket-lib/typed-racket/rep/rep-switch.rkt index 97be1d125..d260e76c8 100644 --- a/typed-racket-lib/typed-racket/rep/rep-switch.rkt +++ b/typed-racket-lib/typed-racket/rep/rep-switch.rkt @@ -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 Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 15/18] Fix 2 occurrences of `sort-with-keyed-comparator-to-sort-by-key` This `sort` expression can be replaced with a simpler, equivalent expression. --- typed-racket-lib/typed-racket/rep/prop-rep.rkt | 3 +-- typed-racket-lib/typed-racket/rep/type-rep.rkt | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/typed-racket-lib/typed-racket/rep/prop-rep.rkt b/typed-racket-lib/typed-racket/rep/prop-rep.rkt index 953332504..069950753 100644 --- a/typed-racket-lib/typed-racket/rep/prop-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/prop-rep.rkt @@ -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 diff --git a/typed-racket-lib/typed-racket/rep/type-rep.rkt b/typed-racket-lib/typed-racket/rep/type-rep.rkt index 2733b6220..4d2813223 100644 --- a/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -1806,7 +1806,7 @@ ;; sorts the given field of a Row by the member name (define (sort-row-clauses clauses) - (sort clauses (λ (x y) (symbol Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 16/18] Fix 1 occurrence of `inverted-when` This negated `when` expression can be replaced by an `unless` expression. --- typed-racket-lib/typed-racket/core.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/typed-racket-lib/typed-racket/core.rkt b/typed-racket-lib/typed-racket/core.rkt index 4e3758ad2..bd5ef1496 100644 --- a/typed-racket-lib/typed-racket/core.rkt +++ b/typed-racket-lib/typed-racket/core.rkt @@ -48,10 +48,12 @@ (and (attribute opt?) (syntax-e (attribute opt?))))] [with-refinements? (and (or (attribute refinement-reasoning?) (with-refinements?)) - (when (not (eq? te-mode deep)) + (unless (eq? te-mode deep) (raise-arguments-error - (string->symbol (format "typed/racket/~a" (keyword->string (syntax-e te-attr)))) - "#:with-refinements unsupported")))]) + (string->symbol (format "typed/racket/~a" + (keyword->string + (syntax-e te-attr)))) + "#:with-refinements unsupported")))]) (tc-module/full te-mode stx pmb-form (λ (new-mod pre-before-code pre-after-code) (define ctc-cache (make-hash)) From a51e0f3789dda9840e17c64ad1a415dcf4bf6d15 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 17/18] Fix 1 occurrence of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- typed-racket-lib/typed-racket/typed-reader.rkt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/typed-racket-lib/typed-racket/typed-reader.rkt b/typed-racket-lib/typed-racket/typed-reader.rkt index d033d488c..3cf83705f 100644 --- a/typed-racket-lib/typed-racket/typed-reader.rkt +++ b/typed-racket-lib/typed-racket/typed-reader.rkt @@ -11,11 +11,11 @@ (define ch (peek-char port)) (unless (eof-object? ch) ;; Consult current readtable: - (let-values ([(like-ch/sym proc dispatch-proc) (readtable-mapping (current-readtable) ch)]) - ;; If like-ch/sym is whitespace, then ch is whitespace - (when (and (char? like-ch/sym) (char-whitespace? like-ch/sym)) - (read-char port) - (skip-whitespace port))))) + (define-values (like-ch/sym proc dispatch-proc) (readtable-mapping (current-readtable) ch)) + ;; If like-ch/sym is whitespace, then ch is whitespace + (when (and (char? like-ch/sym) (char-whitespace? like-ch/sym)) + (read-char port) + (skip-whitespace port)))) (define (skip-comments read-one port src) ;; Recursive read, but skip comments and detect EOF From df625795f8000d990fc541eaa57e0f6e7947d243 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Fri, 28 Feb 2025 00:35:12 +0000 Subject: [PATCH 18/18] Fix 1 occurrence of `cond-let-to-cond-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- typed-racket-lib/typed-racket/typed-reader.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/typed-racket-lib/typed-racket/typed-reader.rkt b/typed-racket-lib/typed-racket/typed-reader.rkt index 3cf83705f..a9f157bcc 100644 --- a/typed-racket-lib/typed-racket/typed-reader.rkt +++ b/typed-racket-lib/typed-racket/typed-reader.rkt @@ -24,8 +24,8 @@ (cond [(special-comment? v) (loop)] [(eof-object? v) - (let-values ([(l c p) (port-next-location port)]) - (raise-read-eof-error "unexpected EOF in type annotation" src l c p 1))] + (define-values (l c p) (port-next-location port)) + (raise-read-eof-error "unexpected EOF in type annotation" src l c p 1)] [else v]))) (define (parse port read-one src)