From d78bd10198c7ce476bd1ddaca8e5d33664ca6ae5 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 14 Jun 2011 17:53:00 -0400
Subject: [PATCH] Make type annotations optional for for*/lists: and
 for*/fold:.

original commit: 48bf6f829066c272a7394595fff3d83617799f98
---
 collects/typed-scheme/base-env/prims.rkt | 61 ++++++++++++++++++------
 1 file changed, 46 insertions(+), 15 deletions(-)

diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt
index 111bc7c9..8ddc9d64 100644
--- a/collects/typed-scheme/base-env/prims.rkt
+++ b/collects/typed-scheme/base-env/prims.rkt
@@ -625,22 +625,53 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (for*/vector: for*/vector)
   (for*/flvector: for*/flvector))
 
-(define-for-syntax (define-for*-folding-variant name)
-  (lambda (stx)
-    (syntax-parse stx #:literals (:)
-      [(_ : ty
-          (var ...)
-          (clause:for*-clause ...)
-          c:expr ...)
-       (quasisyntax/loc stx
-         (#,name : ty
-           (var ...)
-           (clause.expand ... ...)
-           c ...))])))
-
 ;; Like for/lists: and for/fold:, the inferencer can handle these correctly.
-(define-syntax for*/lists: (define-for*-folding-variant #'for/lists:))
-(define-syntax for*/fold:  (define-for*-folding-variant #'for/fold:))
+(define-syntax (for*/lists: stx)
+  (syntax-parse stx #:literals (:)
+    [(_ : ty
+        ((var:optionally-annotated-name) ...)
+        (clause:for*-clause ...)
+        c:expr ...)
+     (syntax-property
+      (quasisyntax/loc stx
+        (for/lists (var.ann-name ...)
+          (clause.expand ... ...)
+          c ...))
+      'type-ascription
+      #'ty)]
+    [(_ ((var:annotated-name) ...)
+        (clause:for*-clause ...)
+        c:expr ...)
+     (syntax-property
+      (quasisyntax/loc stx
+        (for/lists (var.ann-name ...)
+          (clause.expand ... ...)
+          c ...))
+      'type-ascription
+      #'(values var.ty ...))]))
+(define-syntax (for*/fold: stx)
+  (syntax-parse stx #:literals (:)
+    [(_ : ty
+        ((var:optionally-annotated-name init:expr) ...)
+        (clause:for*-clause ...)
+        c:expr ...)
+     (syntax-property
+      (quasisyntax/loc stx
+        (for/fold ((var.ann-name init) ...)
+          (clause.expand ... ...)
+          c ...))
+      'type-ascription
+      #'ty)]
+    [(_ ((var:annotated-name init:expr) ...)
+        (clause:for*-clause ...)
+        c:expr ...)
+     (syntax-property
+      (quasisyntax/loc stx
+        (for/fold ((var.ann-name init) ...)
+          (clause.expand ... ...)
+          c ...))
+      'type-ascription
+      #'(values var.ty ...))]))
 
 (define-syntax (provide: stx)
   (syntax-parse stx