From 312671d85d0c89295c34229132bff01c094834f7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 26 May 2010 17:24:31 -0400
Subject: [PATCH] Added the for:, for/list:, etc macros.

original commit: 5213f54f56e6d9d1a14b16fd0348495a20a648e9
---
 collects/typed-scheme/private/for-clauses.rkt | 17 ++++++++++
 collects/typed-scheme/private/prims.rkt       | 32 ++++++++++++++++++-
 2 files changed, 48 insertions(+), 1 deletion(-)
 create mode 100644 collects/typed-scheme/private/for-clauses.rkt

diff --git a/collects/typed-scheme/private/for-clauses.rkt b/collects/typed-scheme/private/for-clauses.rkt
new file mode 100644
index 00000000..946a6020
--- /dev/null
+++ b/collects/typed-scheme/private/for-clauses.rkt
@@ -0,0 +1,17 @@
+#lang scheme/base
+
+(require syntax/parse
+         "annotate-classes.rkt")
+
+(provide for-clause)
+
+(define-splicing-syntax-class for-clause
+  ;; single-valued seq-expr
+  (pattern (var:annotated-name seq-expr:expr)
+           #:with (expand ...) (list #'(var.ann-name seq-expr)))
+  ;; multi-valued seq-expr
+  (pattern ((var:annotated-name ...) seq-expr:expr)
+           #:with (expand ...) (list #'((var.ann-name ...) seq-expr)))
+  ;; when clause
+  (pattern (~seq #:when guard:expr)
+           #:with (expand ...) (list #'#:when #'guard)))
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index be310b68..71c632d7 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -39,7 +39,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
           (private internal)
 	  (except-in (utils utils tc-utils))
           (env type-name-env)
-          "type-contract.rkt"))
+          "type-contract.rkt"
+          "for-clauses.rkt"))
 
 (require (utils require-contract)
          "colon.rkt"
@@ -378,6 +379,35 @@ This file defines two sorts of primitives. All of them are provided into any mod
               c ...)
             ty))]))
 
+(define-for-syntax (define-for-variant name)
+  (lambda (stx)
+    (syntax-parse stx #:literals (:)
+      [(_ : ty
+          (clause:for-clause ...)
+          c:expr ...)
+       (quasisyntax/loc
+           stx
+         (ann (#,name
+               (clause.expand ... ...)
+               c ...)
+              ty))])))
+(define-syntax (define-for-variants stx)
+  (syntax-parse stx
+    [(_ (name untyped-name) ...)
+     (quasisyntax/loc
+         stx
+       (begin (define-syntax name (define-for-variant #'untyped-name)) ...))]))
+(define-for-variants
+  (for: for)
+  (for/list: for/list)
+  (for/hash: for/hash)
+  (for/hasheq: for/hasheq)
+  (for/hasheqv: for/hasheqv)
+  (for/and: for/and)
+  (for/or: for/or)
+  (for/first: for/first)
+  (for/last: for/last))
+
 (define-syntax (provide: stx)
   (syntax-parse stx
     [(_ [i:id t] ...)