Propagate a trivial expected type for recursive lambda if neccessary

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

@@ -1601,7 +1601,7 @@
 ;; Section 11.1 (Threads)
 
 ;; Section 11.1.1
-[thread (->key (-> Univ) #:keep (Un (-val #f) (-val 'results)) #f #:pool Univ #f -Thread)]
+[thread (->key (-> ManyUniv) #:keep (Un (-val #f) (-val 'results)) #f #:pool Univ #f -Thread)]
 [thread? (unsafe-shallow:make-pred-ty -Thread)]
 [current-thread (-> -Thread)]
 [thread/suspend-to-kill (-> (-> Univ) -Thread)]

typed-racket-lib/typed-racket/rep/rep-utils.rkt

@@ -611,7 +611,8 @@
                   #'(begin)
                   #`(provide #,@non-constr-li)))
             #'(constr-provide nonconstr-provide)])]
-        [struct-def #'(struct var.name parent ... (flds.ids ...)
+        [struct-def (syntax/loc #'var.name
+		      (struct var.name parent ... (flds.ids ...)
                         maybe-transparent ...
                         #:constructor-name constructor-name
                         #:property prop:uid uid-id
@@ -625,7 +626,7 @@
                          Rep-free-idxs-def
                          Rep-for-each-def
                          Rep-fmap-def]
-                        extra-defs ...)])
+                        extra-defs ...))])
        ;; - - - - - - - - - - - - - - -
        ;; macro output
        ;; - - - - - - - - - - - - - - -

typed-racket-lib/typed-racket/typecheck/signatures.rkt

@@ -61,7 +61,7 @@
 
 (define-signature tc-lambda^
   ([cond-contracted tc/lambda (syntax? syntax? syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
-   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? (listof Type?) tc-results/c . -> .
+   [cond-contracted tc/rec-lambda/check (syntax? syntax? syntax? (listof Type?) (or/c #f tc-results/c) . -> .
                                                  (values full-tc-results/c full-tc-results/c))]))
 
 (define-signature tc-app^

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

@@ -33,7 +33,6 @@
   #:literal-sets (kernel-literals)
   ;; let loop
   (pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda (args ...) . body))]) lp*:id) . actuals)
-    #:when expected
     #:when (not (andmap type-annotation (syntax->list #'(lp args ...))))
     #:when (free-identifier=? #'lp #'lp*)
     (let-loop-check #'lam #'lp #'actuals #'(args ...) #'body expected))
@@ -69,12 +68,13 @@
 
 
 (define/cond-contract (let-loop-check lam lp actuals args body expected)
-  (syntax? syntax? syntax? syntax? syntax? tc-results/c . --> . full-tc-results/c)
+  (syntax? syntax? syntax? syntax? syntax? (-or/c #f tc-results/c) . --> . full-tc-results/c)
   (syntax-parse #`(#,args #,body #,actuals)
     #:literal-sets (kernel-literals lambda-literals)
     [((val acc ...)
       ((~and inner-body (if (#%plain-app (~or pair? null?) val*:id) thn els)))
       (actual actuals ...))
+     #:when expected
      #:when
      (and (free-identifier=? #'val #'val*)
           (ormap (lambda (a) (find-annotation #'inner-body a))
@@ -101,6 +101,7 @@
       ((~or (~and inner-body (if e1 e2 e3:id))
             (~and inner-body (let-values () (if e1 e2 e3:id)))))
       (null-exp actuals ...))
+     #:when expected
      #:when (free-identifier=? #'val #'e3)
      #:when (subtype (tc-expr/t #'null-exp) -Null)
      (let ([ts (for/list ([ac (in-syntax #'(actuals ...))]

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

@@ -797,7 +797,9 @@
 ;; Returns both the tc-results of the function and of the body
 (define (tc/rec-lambda/check formals* body name args return)
   (define formals (syntax->list formals*))
-  (define ft (t:->* args (tc-results->values return)))
+  (define ft (if return
+		 (t:->* args (tc-results->values return))
+		 (t:->* args ManyUniv)))
   (define names (cons name formals))
   (with-extended-lexical-env
     [#:identifiers (cons name formals)

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

@@ -22,7 +22,7 @@
          (when l ; still something to read
            (intercept l) ; interceptor gets the whole vector
            (clear-events))))
-     (let: loop : Void ()
+     (let loop ()
        (let ([l : (U Log-Receiver-Sync-Result 'stop)
                (sync receiver stop-chan)])
          (cond [(eq? l 'stop)

typed-racket-test/succeed/events.rkt

@@ -21,7 +21,7 @@
          (when l ; still something to read
            (intercept l) ; interceptor gets the whole vector
            (clear-events))))
-     (let: loop : Void ()
+     (let loop ()
        (let: ([l : (U Log-Receiver-Sync-Result 'stop)
                (sync receiver stop-chan)])
          (cond [(eq? l 'stop)

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

@@ -5283,6 +5283,10 @@
           d0)
         (-lst* (-val 2) (-val "abc") (-ivec* (-val 1) (-val "b") (-val 'x)))]
 
+
+
+       [tc-e (let loop () (loop)) #:ret (-tc-any-results -tt)]
+
        ;; comparisons must correctly account for if the
        ;; #false result was caused by a NaN (see TR Github issue #747)
        ;; less-than
@@ -5718,5 +5722,5 @@
      ([call-with-values (t:-> (t:-> (-values (list -String -String) (list -true-propset -true-propset) (list -empty-obj -empty-obj)))
                               (t:-> -String -String (-values -String -true-propset -empty-obj))
                               (-values -String -true-propset -empty-obj))]))
-   )
+)
   ))