From 00e65ec0ce7e7c7bc6f2b602e7de60b35c62de71 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 01/13] Fix 5 occurrences of `let-to-define`
Internal definitions are recommended instead of `let` expressions, to reduce nesting.
---
.../typed-racket/infer/infer-unit.rkt | 3 +-
.../typed-racket/typecheck/tc-app-helper.rkt | 40 +++++++++++--------
.../typed-racket/typecheck/tc-expr-unit.rkt | 4 +-
.../typed-racket/typecheck/tc-literal.rkt | 10 ++---
.../static-contract-optimizer-tests.rkt | 13 +++---
5 files changed, 39 insertions(+), 31 deletions(-)
diff --git a/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/typed-racket-lib/typed-racket/infer/infer-unit.rkt
index a306c052d..14f85e32f 100644
--- a/typed-racket-lib/typed-racket/infer/infer-unit.rkt
+++ b/typed-racket-lib/typed-racket/infer/infer-unit.rkt
@@ -915,7 +915,8 @@
[(? variance:const?) S]
[(? variance:co?) S]
[(? variance:contra?) T]
- [(? variance:inv?) (let ([gS (generalize S)]) (if (subtype gS T) gS S))]))
+ [(? variance:inv?) (define gS (generalize S))
+ (if (subtype gS T) gS S)]))
;; Since we don't add entries to the empty cset for index variables (since there is no
;; widest constraint, due to dcon-exacts), we must add substitutions here if no constraint
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
index 77e6ea206..396d5f569 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
@@ -328,23 +328,31 @@
msg-rngs)
...))
_))
- (let ([fcn-string (name->function-str name)])
- (if (and (andmap null? msg-doms)
- (null? argtypes))
- (tc-error/expr (string-append
- "Could not infer types for applying polymorphic "
+ (define fcn-string (name->function-str name))
+ (if (and (andmap null? msg-doms) (null? argtypes))
+ (tc-error/expr
+ (string-append "Could not infer types for applying polymorphic " fcn-string "\n"))
+ (domain-mismatches
+ f-stx
+ args-stx
+ t
+ msg-doms
+ msg-rests
+ msg-rngs
+ argtypes
+ #f
+ #f
+ #:expected expected
+ #:msg-thunk
+ (lambda (dom)
+ (string-append "Polymorphic "
fcn-string
- "\n"))
- (domain-mismatches f-stx args-stx t msg-doms msg-rests
- msg-rngs argtypes #f #f #:expected expected
- #:msg-thunk (lambda (dom)
- (string-append
- "Polymorphic " fcn-string " could not be applied to arguments:\n"
- dom
- (if (not (subset? (apply set-union (seteq) (map fv/list msg-doms))
- (list->seteq msg-vars)))
- (string-append "Type Variables: " (stringify msg-vars) "\n")
- ""))))))]
+ " could not be applied to arguments:\n"
+ dom
+ (if (not (subset? (apply set-union (seteq) (map fv/list msg-doms))
+ (list->seteq msg-vars)))
+ (string-append "Type Variables: " (stringify msg-vars) "\n")
+ "")))))]
[(Poly-names:
msg-vars
(DepFun: raw-domain _ raw-rng))
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index 336eaeb09..daa346443 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -143,8 +143,8 @@
(dynamic-wind
(λ () (save-errors!))
(λ ()
- (let ([result (tc-expr/check form expected)])
- (and (not (current-type-error?)) result)))
+ (define result (tc-expr/check form expected))
+ (and (not (current-type-error?)) result))
(λ () (restore-errors!))))))
(define (tc-expr/check/t? form expected)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt b/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt
index 728a718dc..c2fad8704 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt
@@ -184,11 +184,11 @@
(define value->HT
(case-lambda
[(check-element h tycon expected-kt expected-vt)
- (let* ([kts (hash-map h (lambda (x y) (check-element x expected-kt)))]
- [vts (hash-map h (lambda (x y) (check-element y expected-vt)))]
- [kt (apply Un kts)]
- [vt (apply Un vts)])
- (tycon (check-below kt expected-kt) (check-below vt expected-vt)))]
+ (define kts (hash-map h (lambda (x y) (check-element x expected-kt))))
+ (define vts (hash-map h (lambda (x y) (check-element y expected-vt))))
+ (define kt (apply Un kts))
+ (define vt (apply Un vts))
+ (tycon (check-below kt expected-kt) (check-below vt expected-vt))]
[(check-element h tycon)
(define kt (generalize (apply Un (map check-element (hash-keys h)))))
(define vt (generalize (apply Un (map check-element (hash-values h)))))
diff --git a/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt b/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt
index be46d5528..9d16119e0 100644
--- a/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt
+++ b/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt
@@ -32,13 +32,12 @@
(make-check-info 'trusted trusted-side)
(make-check-expected expected))
(λ ()
- (let ([opt (optimize argument
- #:trusted-positive trusted-positive
- #:trusted-negative trusted-negative)])
- (with-check-info* (list (make-check-actual opt))
- (lambda ()
- (unless (equal? opt expected)
- (fail-check))))))))
+ (define opt
+ (optimize argument #:trusted-positive trusted-positive #:trusted-negative trusted-negative))
+ (with-check-info* (list (make-check-actual opt))
+ (lambda ()
+ (unless (equal? opt expected)
+ (fail-check)))))))
(define-syntax (check-syntax stx)
(syntax-parse stx
From 92334a04e304cf2effe80f4f87c9f3cd0ce6bd13 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 02/13] Fix 1 occurrence of `format-identity`
This use of `format` does nothing.
---
typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index daa346443..397fadc28 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -194,7 +194,7 @@
[t:assert-typecheck-failure
(cond
[(tc-expr/check? #'t.body expected)
- (tc-error/expr #:stx #'t.body (format "Expected a type check error!"))]
+ (tc-error/expr #:stx #'t.body "Expected a type check error!")]
[else
(fix-results expected)])]
;; data
From aa658829cb08d1aa612f2624731455357442d10c Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 03/13] Fix 1 occurrence of `if-begin-to-cond`
Using `cond` instead of `if` here makes `begin` unnecessary
---
typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index 397fadc28..8ee907112 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -317,9 +317,11 @@
(attribute opt.value))
(opt-convert fun-type required-pos optional-pos optional-supplied?)]
[_ #f]))
- (if conv-type
- (begin (tc-expr/check/type #'fun conv-type) (fix-results expected))
- (tc-expr/check form #f))]
+ (cond
+ [conv-type
+ (tc-expr/check/type #'fun conv-type)
+ (fix-results expected)]
+ [else (tc-expr/check form #f)])]
[(~and _:kw-lambda^
(let-values ([(f) fun])
(let-values _
From 2bc7fc42cbe7a9ba18c11eb48e486939e6e39229 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 04/13] Fix 1 occurrence of `define-values-values-to-define`
This use of `define-values` is unnecessary.
---
.../typecheck/check-class-unit.rkt | 34 ++++++-------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
index 8b81d8e48..11b22d64e 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
@@ -689,29 +689,17 @@
name-key-or-list))
(hash-ref parse-info name-key-or-list)))
(for/list ([m names]) (dict-ref local-table m)))
- (define-values (localized-method-names
- localized-field-pairs
- localized-private-field-pairs
- localized-inherit-field-pairs
- localized-inherit-names
- localized-private-methods
- localized-override-names
- localized-pubment-names
- localized-augment-names
- localized-inner-names
- localized-init-names)
- (values
- (localize local-method-table 'method-internals)
- (localize local-field-table 'field-internals)
- (localize local-private-field-table 'private-fields)
- (localize local-inherit-field-table 'inherit-field-internals)
- (localize local-inherit-table 'inherit-internals)
- (localize local-private-table 'private-names)
- (localize local-super-table 'override-internals)
- (localize local-augment-table 'pubment-internals)
- (localize local-augment-table 'augment-internals)
- (localize local-inner-table '(pubment-internals augment-internals))
- (localize local-init-table 'only-init-internals)))
+ (define localized-method-names (localize local-method-table 'method-internals))
+ (define localized-field-pairs (localize local-field-table 'field-internals))
+ (define localized-private-field-pairs (localize local-private-field-table 'private-fields))
+ (define localized-inherit-field-pairs (localize local-inherit-field-table 'inherit-field-internals))
+ (define localized-inherit-names (localize local-inherit-table 'inherit-internals))
+ (define localized-private-methods (localize local-private-table 'private-names))
+ (define localized-override-names (localize local-super-table 'override-internals))
+ (define localized-pubment-names (localize local-augment-table 'pubment-internals))
+ (define localized-augment-names (localize local-augment-table 'augment-internals))
+ (define localized-inner-names (localize local-inner-table '(pubment-internals augment-internals)))
+ (define localized-init-names (localize local-init-table 'only-init-internals))
(define localized-field-get-names (map car localized-field-pairs))
(define localized-field-set-names (map cadr localized-field-pairs))
(define localized-private-field-get-names (map car localized-private-field-pairs))
From 5a2e30447dfdc3965ad25c284fd555d6f62e0743 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 05/13] Fix 24 occurrences of `consing-onto-static-list`
This list-constructing expression can be simplified
---
.../typed-racket/private/type-contract.rkt | 2 +-
.../unit-tests/type-alias-helper.rkt | 46 +++++++++----------
2 files changed, 24 insertions(+), 24 deletions(-)
diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt
index 460c7b383..60cc5432b 100644
--- a/typed-racket-lib/typed-racket/private/type-contract.rkt
+++ b/typed-racket-lib/typed-racket/private/type-contract.rkt
@@ -901,7 +901,7 @@
[sc* (remove-duplicates sc*)]
[sc* (remove-overlap sc*
(list
- (cons vector?/sc (list mutable-vector?/sc immutable-vector?/sc))
+ (list vector?/sc mutable-vector?/sc immutable-vector?/sc)
(cons hash?/sc (list mutable-hash?/sc weak-hash?/sc immutable-hash?/sc))))])
(apply shallow-or/sc sc*))]
[t (t->sc t bound-all-vars)])]
diff --git a/typed-racket-test/unit-tests/type-alias-helper.rkt b/typed-racket-test/unit-tests/type-alias-helper.rkt
index d0452a5b8..6fdd382b3 100644
--- a/typed-racket-test/unit-tests/type-alias-helper.rkt
+++ b/typed-racket-test/unit-tests/type-alias-helper.rkt
@@ -13,39 +13,39 @@
;; two aliases in their own components
(define example-1
- (list (cons #'x (list #'x))
- (cons #'y (list #'y))))
+ (list (list #'x #'x)
+ (list #'y #'y)))
;; all one component
(define example-2
- (list (cons #'x (list #'x #'y))
- (cons #'y (list #'x))))
+ (list (list #'x #'x #'y)
+ (list #'y #'x)))
;; two components, one with two nodes
(define example-3
- (list (cons #'x (list #'y))
- (cons #'y (list #'x))
- (cons #'z (list))))
+ (list (list #'x #'y)
+ (list #'y #'x)
+ (list #'z)))
;; one with cycles, two that form a line
(define example-4
- (list (cons #'x (list #'y))
- (cons #'y (list #'x))
- (cons #'a (list #'b))
- (cons #'b (list))))
+ (list (list #'x #'y)
+ (list #'y #'x)
+ (list #'a #'b)
+ (list #'b)))
;; two large cycles
(define example-5
- (list (cons #'x (list #'y #'z))
- (cons #'y (list #'x))
- (cons #'z (list #'x #'y))
- (cons #'a (list #'b))
- (cons #'b (list #'c))
- (cons #'c (list #'a))))
+ (list (list #'x #'y #'z)
+ (list #'y #'x)
+ (list #'z #'x #'y)
+ (list #'a #'b)
+ (list #'b #'c)
+ (list #'c #'a)))
;; check topological order
(define example-6
- (list (cons #'a (list #'b))
- (cons #'d (list))
- (cons #'c (list #'d #'e))
- (cons #'b (list #'c))
- (cons #'e (list #'f))
- (cons #'f (list))))
+ (list (list #'a #'b)
+ (list #'d)
+ (list #'c #'d #'e)
+ (list #'b #'c)
+ (list #'e #'f)
+ (list #'f)))
;; helper function for the tests below
;; ignores order of ids in the components and the
From 149f1f682bfc66a5085127533899160776b3c458 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 06/13] Fix 1 occurrence of
`define-syntax-syntax-rules-to-define-syntax-rule`
This `define-syntax` macro can be replaced with a simpler, equivalent `define-syntax-rule` macro.
---
typed-racket-test/unit-tests/parse-type-tests.rkt | 8 +++-----
1 file changed, 3 insertions(+), 5 deletions(-)
diff --git a/typed-racket-test/unit-tests/parse-type-tests.rkt b/typed-racket-test/unit-tests/parse-type-tests.rkt
index 298b894d2..42bca6950 100644
--- a/typed-racket-test/unit-tests/parse-type-tests.rkt
+++ b/typed-racket-test/unit-tests/parse-type-tests.rkt
@@ -85,11 +85,9 @@
(with-check-info (['expected expected] ['actual actual])
(fail-check "Unequal types")))))]))
-(define-syntax pt-tests
- (syntax-rules ()
- [(_ nm [elems ...] ...)
- (test-suite nm
- (pt-test elems ...) ...)]))
+(define-syntax-rule (pt-tests nm [elems ...] ...)
+ (test-suite nm
+ (pt-test elems ...) ...))
(define-for-syntax N -Number)
(define-for-syntax B -Boolean)
From b503d6a0335665ccf054f2b2479dc40388effa50 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 07/13] Fix 1 occurrence of
`single-clause-match-to-match-define`
This `match` expression can be simplified using `match-define`.
---
.../typed-racket/static-contracts/combinators/unit.rkt | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/unit.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/unit.rkt
index 8ea8181bf..b55e2e4bd 100644
--- a/typed-racket-lib/typed-racket/static-contracts/combinators/unit.rkt
+++ b/typed-racket-lib/typed-racket/static-contracts/combinators/unit.rkt
@@ -61,10 +61,9 @@
(list invoke/scs ...)))
v)
(define (sig-spec->syntax sig-spec)
- (match sig-spec
- [(signature-spec name members scs)
- (define member-stx (map (lambda (id sc) #`(#,id #,(f sc))) members scs))
- #`(#,name #,@member-stx)]))
+ (match-define (signature-spec name members scs) sig-spec)
+ (define member-stx (map (lambda (id sc) #`(#,id #,(f sc))) members scs))
+ #`(#,name #,@member-stx))
(define (invokes->contract lst)
(cond
From 1bd505d47f51661b55aad6159369b64a4f029ed5 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 08/13] Fix 1 occurrence of `predicate/c-migration`
The `predicate/c` contract is less clear than a `->` contract and no longer improves performance.
---
typed-racket-test/unit-tests/typecheck-tests.rkt | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt
index 8bd94ff4f..128b3f445 100644
--- a/typed-racket-test/unit-tests/typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -9,7 +9,7 @@
(contract-out
[rename cross-phase-failure* cross-phase-failure
(->* (string?) (#:actual any/c #:expected any/c) cross-phase-failure?)]
- [cross-phase-failure? predicate/c]
+ [cross-phase-failure? (-> any/c boolean?)]
[cross-phase-failure-message (-> cross-phase-failure? string?)]
[rename cross-phase-failure-check-infos* cross-phase-failure-check-infos
(-> cross-phase-failure? (listof check-info?))]))
From cabf679bebed260a953f850f41c493459a486f3f Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 09/13] Fix 1 occurrence of `define-let-to-double-define`
This `let` expression can be pulled up into a `define` expression.
---
typed-racket-test/unit-tests/typecheck-tests.rkt | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt
index 128b3f445..34790b830 100644
--- a/typed-racket-test/unit-tests/typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -145,9 +145,11 @@
;; 2. search `expr` for occurrences of `f`
;; 3. check that the type-table entry for `f` matches `t`
(define (test-type-table expr assoc)
+ (define expr+ (tr-expand expr))
(define expanded-expr
- (let ([expr+ (tr-expand expr)])
- (begin (tc expr+ #f) expr+)))
+ (begin
+ (tc expr+ #f)
+ expr+))
(define expected-results
(make-free-id-table assoc))
(let loop ([x expanded-expr]) ;; loop : any/c -> void?
From 3d6014dfac9472554794bfd8b5c1127183b3099c Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 10/13] Fix 1 occurrence of `cond-let-to-cond-define`
Internal definitions are recommended instead of `let` expressions, to reduce nesting.
---
.../typed-racket/infer/intersect.rkt | 61 ++++++++++---------
1 file changed, 31 insertions(+), 30 deletions(-)
diff --git a/typed-racket-lib/typed-racket/infer/intersect.rkt b/typed-racket-lib/typed-racket/infer/intersect.rkt
index 3754f3a73..579730a0e 100644
--- a/typed-racket-lib/typed-racket/infer/intersect.rkt
+++ b/typed-racket-lib/typed-racket/infer/intersect.rkt
@@ -178,37 +178,38 @@
(-unsafe-intersect initial-t1 initial-t2)
initial-t1)]
[else
- (let ([t2 (if (resolvable? initial-t2)
- (resolve-once initial-t2)
- initial-t2)])
- (cond
- ;; if t2 is not a fully defined type, do the simple thing
- [(not t2)
- (if additive?
- (-unsafe-intersect t1 initial-t2)
- t1)]
- [else
- ;; we've never seen these types together before! let's gensym a symbol
- ;; so that if we do encounter them again, we can create a μ type.
- (define name (gensym 'rec))
- ;; the 'record' contains the back pointer symbol we may or may not use in
- ;; the car, and a flag for whether or not we actually used the back pointer
- ;; in the cdr.
- (define record (mcons name #f))
- (define seen*
- (list* (cons (cons initial-t1 initial-t2) record)
- (cons (cons initial-t2 initial-t1) record)
- seen))
- (define t
- (cond
- [additive? (internal-intersect t1 t2 seen* obj)]
- [else (internal-restrict t1 t2 seen* obj)]))
+ (define t2
+ (if (resolvable? initial-t2)
+ (resolve-once initial-t2)
+ initial-t2))
+ (cond
+ ;; if t2 is not a fully defined type, do the simple thing
+ [(not t2)
+ (if additive?
+ (-unsafe-intersect t1 initial-t2)
+ t1)]
+ [else
+ ;; we've never seen these types together before! let's gensym a symbol
+ ;; so that if we do encounter them again, we can create a μ type.
+ (define name (gensym 'rec))
+ ;; the 'record' contains the back pointer symbol we may or may not use in
+ ;; the car, and a flag for whether or not we actually used the back pointer
+ ;; in the cdr.
+ (define record (mcons name #f))
+ (define seen*
+ (list* (cons (cons initial-t1 initial-t2) record)
+ (cons (cons initial-t2 initial-t1) record)
+ seen))
+ (define t
(cond
- ;; check if we used the backpointer, if so,
- ;; make a recursive type using that name
- [(mcdr record) (make-Mu name t)]
- ;; otherwise just return the result
- [else t])]))]))
+ [additive? (internal-intersect t1 t2 seen* obj)]
+ [else (internal-restrict t1 t2 seen* obj)]))
+ (cond
+ ;; check if we used the backpointer, if so,
+ ;; make a recursive type using that name
+ [(mcdr record) (make-Mu name t)]
+ ;; otherwise just return the result
+ [else t])])]))
;; intersect
From 85e30c2229a8459f72dbdcb54ab6d87d1f9e9bb1 Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 11/13] Fix 10 occurrences of `define-lambda-to-define`
The `define` form supports a shorthand for defining functions.
---
.../typecheck/check-unit-unit.rkt | 3 +-
.../typecheck/integer-refinements.rkt | 224 ++++++++----------
.../unit-tests/contract-tests.rkt | 13 +-
3 files changed, 110 insertions(+), 130 deletions(-)
diff --git a/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
index 947eab7c7..5e18b7e81 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt
@@ -175,7 +175,8 @@
;; this map is used to determine the actual signatures corresponding to the
;; given signature tags of the init-depends
(define tag-map (make-immutable-free-id-table (map cons import-tags import-sigs)))
- (define lookup-temp (λ (temp) (free-id-table-ref export-temp-internal-map temp #f)))
+ (define (lookup-temp temp)
+ (free-id-table-ref export-temp-internal-map temp #f))
(values (for/list ([sig-id (in-list import-sigs)]
[sig-internal-ids (in-list import-internal-ids)])
diff --git a/typed-racket-lib/typed-racket/typecheck/integer-refinements.rkt b/typed-racket-lib/typed-racket/typecheck/integer-refinements.rkt
index 2a6f18883..6446860f3 100644
--- a/typed-racket-lib/typed-racket/typecheck/integer-refinements.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/integer-refinements.rkt
@@ -71,143 +71,127 @@
#:attr obj (if (Object? o) o -empty-obj)))
;; < <= >= =
-(define (numeric-comparison-function prop-constructor)
- (λ (args-stx result)
- (syntax-parse args-stx
- [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
- (define p (prop-constructor (attribute e1.obj) (attribute e2.obj)))
- (add-p/not-p result p)]
- [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)) (~var e3 (w/type -Int)))
- #:when (or (and (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
- (and (Object? (attribute e2.obj)) (Object? (attribute e3.obj))))
- (define p (-and (prop-constructor (attribute e1.obj) (attribute e2.obj))
- (prop-constructor (attribute e2.obj) (attribute e3.obj))))
- (add-p/not-p result p)]
- [_ result])))
+(define ((numeric-comparison-function prop-constructor) args-stx result)
+ (syntax-parse args-stx
+ [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+ (define p (prop-constructor (attribute e1.obj) (attribute e2.obj)))
+ (add-p/not-p result p)]
+ [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)) (~var e3 (w/type -Int)))
+ #:when (or (and (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
+ (and (Object? (attribute e2.obj)) (Object? (attribute e3.obj))))
+ (define p
+ (-and (prop-constructor (attribute e1.obj) (attribute e2.obj))
+ (prop-constructor (attribute e2.obj) (attribute e3.obj))))
+ (add-p/not-p result p)]
+ [_ result]))
;; +/-
-(define (plus/minus plus?)
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- ;; +/- (2 args)
- [((~var e1 (w/obj+type -Int))
- (~var e2 (w/obj+type -Int)))
- (define (sign o) (if plus? o (scale-obj -1 o)))
- (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj))))
- (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
- ps
- l)]
- ;; +/- (3 args)
- [((~var e1 (w/obj+type -Int))
- (~var e2 (w/obj+type -Int))
- (~var e3 (w/obj+type -Int)))
- (define (sign o) (if plus? o (scale-obj -1 o)))
- (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj)) (sign (attribute e3.obj))))
- (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
- ps
- l)]
- [_ result])]
- [_ result])))
+(define ((plus/minus plus?) args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ ;; +/- (2 args)
+ [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+ (define (sign o)
+ (if plus?
+ o
+ (scale-obj -1 o)))
+ (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj))))
+ (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+ ;; +/- (3 args)
+ [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)) (~var e3 (w/obj+type -Int)))
+ (define (sign o)
+ (if plus?
+ o
+ (scale-obj -1 o)))
+ (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj)) (sign (attribute e3.obj))))
+ (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+ [_ result])]
+ [_ result]))
;; equal?/eqv?/eq?
;; if only one side is a supported type, we can learn integer equality for
;; a result of `#t`, whereas if both sides are of the supported type,
;; we learn on both `#t` and `#f` answers
-(define (equality-function supported-type)
- (λ (args-stx result)
- (syntax-parse args-stx
- [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type supported-type)))
- (define p (-eq (attribute e1.obj) (attribute e2.obj)))
- (add-p/not-p result p)]
- [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type Univ)))
- (define p (-eq (attribute e1.obj) (attribute e2.obj)))
- (add-to-pos-side result p)]
- [((~var e1 (w/obj+type Univ)) (~var e2 (w/obj+type supported-type)))
- (define p (-eq (attribute e1.obj) (attribute e2.obj)))
- (add-to-pos-side result p)]
- [_ result])))
+(define ((equality-function supported-type) args-stx result)
+ (syntax-parse args-stx
+ [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type supported-type)))
+ (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+ (add-p/not-p result p)]
+ [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type Univ)))
+ (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+ (add-to-pos-side result p)]
+ [((~var e1 (w/obj+type Univ)) (~var e2 (w/obj+type supported-type)))
+ (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+ (add-to-pos-side result p)]
+ [_ result]))
;; *
-(define product-function
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
- (define product-obj (-obj* (attribute e1.obj) (attribute e2.obj)))
- (cond
- [(Object? product-obj)
- (ret (-refine/fresh x ret-t (-eq (-lexp x) product-obj))
- ps
- product-obj)]
- [else result])]
- [_ result])]
- [_ result])))
+(define (product-function args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+ (define product-obj (-obj* (attribute e1.obj) (attribute e2.obj)))
+ (cond
+ [(Object? product-obj)
+ (ret (-refine/fresh x ret-t (-eq (-lexp x) product-obj)) ps product-obj)]
+ [else result])]
+ [_ result])]
+ [_ result]))
;; make-vector
-(define make-vector-function
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- [((~var size (w/obj+type -Int)) . _)
- (ret (-refine/fresh v ret-t (-eq (-lexp (-vec-len-of (-id-path v)))
- (attribute size.obj)))
- ps
- orig-obj)]
- [_ result])]
- [_ result])))
+(define (make-vector-function args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ [((~var size (w/obj+type -Int)) . _)
+ (ret (-refine/fresh v ret-t (-eq (-lexp (-vec-len-of (-id-path v))) (attribute size.obj)))
+ ps
+ orig-obj)]
+ [_ result])]
+ [_ result]))
;; modulo
-(define modulo-function
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- [((~var e1 (w/type -Int)) (~var e2 (w/obj+type -Nat)))
- (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e2.obj)))
- ps
- orig-obj)]
- [_ result])]
- [_ result])))
+(define (modulo-function args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ [((~var e1 (w/type -Int)) (~var e2 (w/obj+type -Nat)))
+ (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e2.obj))) ps orig-obj)]
+ [_ result])]
+ [_ result]))
;; random
-(define random-function
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- ;; random (1 arg)
- [((~var e1 (w/obj+type -Nat)))
- (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e1.obj)))
- ps
- orig-obj)]
- ;; random (2 arg)
- [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)))
- #:when (or (Object? (attribute e1.obj))
- (Object? (attribute e2.obj)))
- (ret (-refine/fresh x ret-t (-and (-leq (attribute e1.obj) (-lexp x))
- (-lt (-lexp x) (attribute e2.obj))))
- ps
- orig-obj)]
- [_ result])]
- [_ result])))
+(define (random-function args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ ;; random (1 arg)
+ [((~var e1 (w/obj+type -Nat)))
+ (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e1.obj))) ps orig-obj)]
+ ;; random (2 arg)
+ [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)))
+ #:when (or (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
+ (ret (-refine/fresh x
+ ret-t
+ (-and (-leq (attribute e1.obj) (-lexp x))
+ (-lt (-lexp x) (attribute e2.obj))))
+ ps
+ orig-obj)]
+ [_ result])]
+ [_ result]))
;; add1 / sub1
-(define (add/sub-1-function add?)
- (λ (args-stx result)
- (match result
- [(tc-result1: ret-t ps orig-obj)
- (syntax-parse args-stx
- [((~var e1 (w/obj+type -Int)))
- (define l ((if add? -lexp-add1 -lexp-sub1) (attribute e1.obj)))
- (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
- ps
- l)]
- [_ result])]
- [_ result])))
+(define ((add/sub-1-function add?) args-stx result)
+ (match result
+ [(tc-result1: ret-t ps orig-obj)
+ (syntax-parse args-stx
+ [((~var e1 (w/obj+type -Int)))
+ (define l ((if add? -lexp-add1 -lexp-sub1) (attribute e1.obj)))
+ (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+ [_ result])]
+ [_ result]))
(define linear-integer-function-table
(make-immutable-free-id-table
diff --git a/typed-racket-test/unit-tests/contract-tests.rkt b/typed-racket-test/unit-tests/contract-tests.rkt
index e599c8f5f..515ad0866 100644
--- a/typed-racket-test/unit-tests/contract-tests.rkt
+++ b/typed-racket-test/unit-tests/contract-tests.rkt
@@ -115,15 +115,10 @@
(define-syntax-rule (t-int arg ...)
(t-int/check arg ... check-not-exn))
-(define (check-re re loc)
- (λ (thunk)
- (with-check-info* (list (make-check-location loc))
- (lambda ()
- (check-exn
- (λ (e)
- (and (exn:fail? e)
- (regexp-match? re (exn-message e))))
- thunk)))))
+(define ((check-re re loc) thunk)
+ (with-check-info*
+ (list (make-check-location loc))
+ (lambda () (check-exn (λ (e) (and (exn:fail? e) (regexp-match? re (exn-message e)))) thunk))))
;; (t-int/fail type (-> any any) any #:msg regexp)
;; Like t-int, but checks failing cases. Takes a regexp for checking
From bb12010a248ad561921458dc1c1cfbf3d0f08ebf Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 12/13] 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/env/global-env.rkt | 4 +---
typed-racket-lib/typed-racket/env/init-envs.rkt | 7 +++----
2 files changed, 4 insertions(+), 7 deletions(-)
diff --git a/typed-racket-lib/typed-racket/env/global-env.rkt b/typed-racket-lib/typed-racket/env/global-env.rkt
index 6c026e7d5..059469d67 100644
--- a/typed-racket-lib/typed-racket/env/global-env.rkt
+++ b/typed-racket-lib/typed-racket/env/global-env.rkt
@@ -75,9 +75,7 @@
(define (maybe-finish-register-type id)
(define v (free-id-table-ref the-mapping id))
- (if (box? v)
- (register-type id (unbox v))
- #f))
+ (and (box? v) (register-type id (unbox v))))
(define (unregister-type id)
(free-id-table-remove! the-mapping id))
diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt
index 3cdecf0ba..4b0614fe1 100644
--- a/typed-racket-lib/typed-racket/env/init-envs.rkt
+++ b/typed-racket-lib/typed-racket/env/init-envs.rkt
@@ -437,10 +437,9 @@
(define (bound-in-this-module id)
(define binding (identifier-binding id))
- (if (and (list? binding) (module-path-index? (car binding)))
- (let-values ([(mp base) (module-path-index-split (car binding))])
- (not mp))
- #f))
+ (and (and (list? binding) (module-path-index? (car binding)))
+ (let-values ([(mp base) (module-path-index-split (car binding))])
+ (not mp))))
(define (make-init-code map f)
(define (bound-f id v)
From 9474828414da1ae22e52a1a84ae144cb9708737b Mon Sep 17 00:00:00 2001
From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com>
Date: Fri, 11 Jul 2025 01:58:28 +0000
Subject: [PATCH 13/13] Fix 1 occurrence of `if-let-to-cond`
`cond` with internal definitions is preferred over `if` with `let`, to reduce nesting
---
typed-racket-test/unit-tests/interactive-tests.rkt | 14 +++++++-------
1 file changed, 7 insertions(+), 7 deletions(-)
diff --git a/typed-racket-test/unit-tests/interactive-tests.rkt b/typed-racket-test/unit-tests/interactive-tests.rkt
index dd542c8ae..7501ffb4f 100644
--- a/typed-racket-test/unit-tests/interactive-tests.rkt
+++ b/typed-racket-test/unit-tests/interactive-tests.rkt
@@ -28,13 +28,13 @@
;; If the argument is true, then it is a new namespace. This is slower but allows for tests that need
;; to mutate the namespace to not clash with each other.
(define (get-ns fresh)
- (if fresh
- (let ([ns (variable-reference->empty-namespace
- (eval '(#%variable-reference) (force base-ns)))])
- (parameterize ([current-namespace ns])
- (namespace-require 'typed/racket/base)
- ns))
- (force base-ns)))
+ (cond
+ [fresh
+ (define ns (variable-reference->empty-namespace (eval '(#%variable-reference) (force base-ns))))
+ (parameterize ([current-namespace ns])
+ (namespace-require 'typed/racket/base)
+ ns)]
+ [else (force base-ns)]))
(begin-for-syntax
(define-splicing-syntax-class fresh-kw
pFad - Phonifier reborn
Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.
Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.
Alternative Proxies:
Alternative Proxy
pFad Proxy
pFad v3 Proxy
pFad v4 Proxy