Skip to content

Commit 7c46e05

Browse files
committed
Propagate a trivial expected type for recursive lambda if neccessary.
This does not apply an expected type to the actual function body, it just gives a type to the function when referred to recursively. This addresses a problem with inference for let loop in lambda as the argument to `thread` now that `thread` is a keyword function and therefore lifts its arguments to a `let` ahead of the function. Fixing the relevant problem also requires improving the type of `thread`.
1 parent d2c1ac7 commit 7c46e05

File tree

6 files changed

+13
-6
lines changed

6 files changed

+13
-6
lines changed

typed-racket-lib/typed-racket/base-env/base-env.rkt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1601,7 +1601,7 @@
16011601
;; Section 11.1 (Threads)
16021602

16031603
;; Section 11.1.1
1604-
[thread (->key (-> Univ) #:keep (Un (-val #f) (-val 'results)) #f #:pool Univ #f -Thread)]
1604+
[thread (->key (-> ManyUniv) #:keep (Un (-val #f) (-val 'results)) #f #:pool Univ #f -Thread)]
16051605
[thread? (unsafe-shallow:make-pred-ty -Thread)]
16061606
[current-thread (-> -Thread)]
16071607
[thread/suspend-to-kill (-> (-> Univ) -Thread)]

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@
3333
#:literal-sets (kernel-literals)
3434
;; let loop
3535
(pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda (args ...) . body))]) lp*:id) . actuals)
36-
#:when expected
3736
#:when (not (andmap type-annotation (syntax->list #'(lp args ...))))
3837
#:when (free-identifier=? #'lp #'lp*)
3938
(let-loop-check #'lam #'lp #'actuals #'(args ...) #'body expected))
@@ -75,6 +74,7 @@
7574
[((val acc ...)
7675
((~and inner-body (if (#%plain-app (~or pair? null?) val*:id) thn els)))
7776
(actual actuals ...))
77+
#:when expected
7878
#:when
7979
(and (free-identifier=? #'val #'val*)
8080
(ormap (lambda (a) (find-annotation #'inner-body a))
@@ -101,6 +101,7 @@
101101
((~or (~and inner-body (if e1 e2 e3:id))
102102
(~and inner-body (let-values () (if e1 e2 e3:id)))))
103103
(null-exp actuals ...))
104+
#:when expected
104105
#:when (free-identifier=? #'val #'e3)
105106
#:when (subtype (tc-expr/t #'null-exp) -Null)
106107
(let ([ts (for/list ([ac (in-syntax #'(actuals ...))]

typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -797,7 +797,9 @@
797797
;; Returns both the tc-results of the function and of the body
798798
(define (tc/rec-lambda/check formals* body name args return)
799799
(define formals (syntax->list formals*))
800-
(define ft (t:->* args (tc-results->values return)))
800+
(define ft (if return
801+
(t:->* args (tc-results->values return))
802+
(t:->* args ManyUniv)))
801803
(define names (cons name formals))
802804
(with-extended-lexical-env
803805
[#:identifiers (cons name formals)

typed-racket-test/succeed/events-with-async-channel.rkt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@
2222
(when l ; still something to read
2323
(intercept l) ; interceptor gets the whole vector
2424
(clear-events))))
25-
(let: loop : Void ()
25+
(let loop ()
2626
(let ([l : (U Log-Receiver-Sync-Result 'stop)
2727
(sync receiver stop-chan)])
2828
(cond [(eq? l 'stop)

typed-racket-test/succeed/events.rkt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
(when l ; still something to read
2222
(intercept l) ; interceptor gets the whole vector
2323
(clear-events))))
24-
(let: loop : Void ()
24+
(let loop ()
2525
(let: ([l : (U Log-Receiver-Sync-Result 'stop)
2626
(sync receiver stop-chan)])
2727
(cond [(eq? l 'stop)

typed-racket-test/unit-tests/typecheck-tests.rkt

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5283,6 +5283,10 @@
52835283
d0)
52845284
(-lst* (-val 2) (-val "abc") (-ivec* (-val 1) (-val "b") (-val 'x)))]
52855285

5286+
5287+
5288+
[tc-e (let loop () (loop)) #:ret (-tc-any-results -tt)]
5289+
52865290
;; comparisons must correctly account for if the
52875291
;; #false result was caused by a NaN (see TR Github issue #747)
52885292
;; less-than
@@ -5718,5 +5722,5 @@
57185722
([call-with-values (t:-> (t:-> (-values (list -String -String) (list -true-propset -true-propset) (list -empty-obj -empty-obj)))
57195723
(t:-> -String -String (-values -String -true-propset -empty-obj))
57205724
(-values -String -true-propset -empty-obj))]))
5721-
)
5725+
)
57225726
))

0 commit comments

Comments
 (0)