From f5f84c762530b45514db024a0e8482326e715ecd Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Tue, 25 Aug 2015 01:43:16 -0400
Subject: [PATCH] Fix for*/fold and for*/lists

Only parse and use the type annotations if they are present on
all fold variables. This matches the default for other forms in TR.
Also, this will usually result in a "insufficient type information"
message which is more helpful than if TR chose some default type.

Closes PR 15138
Closes PR 14893
---
 .../typed-racket/base-env/prims.rkt           | 30 +++++++++++--------
 .../unit-tests/typecheck-tests.rkt            |  7 +++++
 2 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/typed-racket-lib/typed-racket/base-env/prims.rkt b/typed-racket-lib/typed-racket/base-env/prims.rkt
index aeab81a7..08beffc6 100644
--- a/typed-racket-lib/typed-racket/base-env/prims.rkt
+++ b/typed-racket-lib/typed-racket/base-env/prims.rkt
@@ -481,14 +481,17 @@ the typed racket language.
         clause:for-clauses
         a2:optional-standalone-annotation*
         c ...)
+     (define all-typed? (andmap values (attribute var.ty)))
+     (define for-stx
+       (quasisyntax/loc stx
+         (for/lists (var.ann-name ...)
+             (clause.expand* ... ...)
+           c ...)))
      ((attribute a1.annotate)
       ((attribute a2.annotate)
-       (add-ann
-        (quasisyntax/loc stx
-          (for/lists (var.ann-name ...)
-              (clause.expand* ... ...)
-            c ...))
-        #'(values var.ty ...))))]))
+       (if all-typed?
+           (add-ann for-stx #'(values var.ty ...))
+           for-stx)))]))
 (define-syntax (for*/fold: stx)
   (syntax-parse stx #:literals (:)
     [(_ a1:optional-standalone-annotation*
@@ -496,14 +499,17 @@ the typed racket language.
         clause:for-clauses
         a2:optional-standalone-annotation*
         c ...)
+     (define all-typed? (andmap values (attribute var.ty)))
+     (define for-stx
+       (quasisyntax/loc stx
+         (for/fold ((var.ann-name init) ...)
+             (clause.expand* ... ...)
+           c ...)))
      ((attribute a1.annotate)
       ((attribute a2.annotate)
-       (add-ann
-        (quasisyntax/loc stx
-          (for/fold ((var.ann-name init) ...)
-              (clause.expand* ... ...)
-            c ...))
-        #'(values var.ty ...))))]))
+       (if all-typed?
+           (add-ann for-stx #'(values var.ty ...))
+           for-stx)))]))
 
 (define-for-syntax (define-for/acc:-variant for*? for/folder: for/folder op initial final)
   (lambda (stx)
diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt
index b445befd..d8ab72ff 100644
--- a/typed-racket-test/unit-tests/typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -3783,6 +3783,13 @@
        [tc-err (let ()
                  (define x (eval 0))
                  x)]
+
+       ;; PR 15138
+       [tc-e (for*/lists: ((xs : (Listof Symbol))) ((x '(a b c))) x)
+             #:ret (ret (-lst -Symbol) (-FS -top -bot) -empty-obj)]
+       [tc-e (for*/fold: ((xs : (Listof Symbol) '())) ((x '(a b c)))
+               (cons x xs))
+             (-lst -Symbol)]
        )
 
   (test-suite