From 080f4a1b01661386737108ff273fe547a072dff2 Mon Sep 17 00:00:00 2001
From: Will M. Farr <w-farr@northwestern.edu>
Date: Mon, 23 Aug 2010 09:22:58 -0500
Subject: [PATCH 3/3] New updates to for/vector, for*/vector, for/flvector and for*/flvector.

Now use for/fold to thread the index through the iteration form, so
that all variants can take advantage of the optional #:length
argument.  Previously, only the for/vector and for/flvector used the

The behavior when #:length does not match the number of iterations has
changed: iteration stops when either the vector is full, or the
requested number of iterations has been achieved, whichever comes
first.  If #:length is larger than the number of iterations performed,
then the remaining slots in the vector are filled with the default
argument of (make-vector ...), which is currently 0.
---
 collects/racket/flonum.rkt               |   61 +++++++++++++++++------------
 collects/racket/private/for.rkt          |   62 ++++++++++++++++++------------
 collects/scribblings/guide/for.scrbl     |   16 +++++--
 collects/scribblings/reference/for.scrbl |   20 ++++++----
 collects/tests/racket/flonum.rktl        |   22 +++++++++--
 collects/tests/racket/for.rktl           |   23 +++++++++--
 6 files changed, 133 insertions(+), 71 deletions(-)

diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt
index 7cb0abd..fd2e364 100644
--- a/collects/racket/flonum.rkt
+++ b/collects/racket/flonum.rkt
@@ -47,29 +47,40 @@
         (flvector-set! v i x))
       v)))
 
-(define-syntax for/flvector
-  (lambda (stx)
-    (syntax-case stx ()
-      ((for/flvector (for-clause ...) body ...)
-       (syntax/loc stx
-         (list->flvector (for/list (for-clause ...) body ...))))
-      ((for/flvector #:length len-expr (for-clause ...) body ...)
-       (syntax/loc stx
-         (let ((len len-expr))
-           (let ((flv (make-flvector len)))
-             (for ((i (in-naturals))
-                   for-clause 
-                   ...)
-               (when (fx>= i len) (error 'for/flvector "too many iterations for vector of length ~a" len))
-               (flvector-set! flv i (begin body ...)))
-             flv)))))))
+(define-syntax (for/flvector stx)
+  (syntax-case stx ()
+    ((for/flvector (for-clause ...) body ...)
+     (syntax/loc stx
+       (list->flvector 
+        (for/list (for-clause ...) body ...))))
+    ((for/flvector #:length length-expr (for-clause ...) body ...)
+     (syntax/loc stx
+       (let ((len length-expr))
+         (unless (exact-nonnegative-integer? len)
+           (raise-type-error 'for/flvector "exact nonnegative integer" len))
+         (let ((v (make-flvector len)))
+           (for/fold ((i 0))
+               (for-clause ... 
+                #:when (< i len))
+             (flvector-set! v i (begin body ...))
+             (add1 i))
+           v))))))
 
-(define-syntax for*/flvector
-  (lambda (stx)
-    (syntax-case stx ()
-      ((for*/flvector (for-clause ...) body ...)
-       (syntax/loc stx
-         (list->flvector (for*/list (for-clause ...) body ...))))
-      ((for*/flvector #:length len-expr (for-clause ...) body ...)
-       (syntax/loc stx
-         (for*/flvector (for-clause ...) body ...))))))
\ No newline at end of file
+(define-syntax (for*/flvector stx)
+  (syntax-case stx ()
+    ((for*/flvector (for-clause ...) body ...)
+     (syntax/loc stx
+       (list->flvector 
+        (for*/list (for-clause ...) body ...))))
+    ((for*/flvector #:length length-expr (for-clause ...) body ...)
+     (syntax/loc stx
+       (let ((len length-expr))
+         (unless (exact-nonnegative-integer? len)
+           (raise-type-error 'for*/flvector "exact nonnegative integer" len))
+         (let ((v (make-flvector len)))
+           (for*/fold ((i 0))
+               (for-clause ...
+                #:when (< i len))
+             (flvector-set! v i (begin body ...))
+             (add1 i))
+           v))))))
\ No newline at end of file
diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt
index 3a06c1f..52d7853 100644
--- a/collects/racket/private/for.rkt
+++ b/collects/racket/private/for.rkt
@@ -909,31 +909,43 @@
     (lambda (x) x)
     (lambda (x) `(,#'cons ,x ,#'fold-var)))
 
-  (define-syntax for/vector
-    (lambda (stx)
-      (syntax-case stx ()
-        ((for/vector (for-clause ...) body ...)
-         (syntax/loc stx
-           (list->vector (for/list (for-clause ...) body ...))))
-        ((for/vector #:length size-expr (for-clause ...) body ...)
-         (syntax/loc stx
-           (let ((len size-expr))
-             (let ((v (make-vector len)))
-               (for ((i (in-naturals))
-                     for-clause ...)
-                 (when (>= i len) (error 'for/vector "too many iterations for vector of length ~a" len))
-                 (vector-set! v i (begin body ...)))
-               v)))))))
-
-  (define-syntax for*/vector
-    (lambda (stx)
-      (syntax-case stx ()
-        ((for*/vector (for-clause ...) body ...)
-         (syntax/loc stx
-           (list->vector (for*/list (for-clause ...) body ...))))
-        ((for*/vector #:length len-expr (for-clause ...) body ...)
-         (syntax/loc stx
-           (for*/vector (for-clause ...) body ...))))))
+  (define-syntax (for/vector stx)
+    (syntax-case stx ()
+      ((for/vector (for-clause ...) body ...)
+       (syntax/loc stx
+         (list->vector 
+          (for/list (for-clause ...) body ...))))
+      ((for/vector #:length length-expr (for-clause ...) body ...)
+       (syntax/loc stx
+         (let ((len length-expr))
+           (unless (exact-nonnegative-integer? len)
+             (raise-type-error 'for/vector "exact nonnegative integer" len))
+           (let ((v (make-vector len)))
+             (for/fold ((i 0))
+                 (for-clause ... 
+                             #:when (< i len))
+               (vector-set! v i (begin body ...))
+               (add1 i))
+             v))))))
+
+  (define-syntax (for*/vector stx)
+    (syntax-case stx ()
+      ((for*/vector (for-clause ...) body ...)
+       (syntax/loc stx
+         (list->vector 
+          (for*/list (for-clause ...) body ...))))
+      ((for*/vector #:length length-expr (for-clause ...) body ...)
+       (syntax/loc stx
+         (let ((len length-expr))
+           (unless (exact-nonnegative-integer? len)
+             (raise-type-error 'for*/vector "exact nonnegative integer" len))
+           (let ((v (make-vector len)))
+             (for*/fold ((i 0))
+                 (for-clause ...
+                  #:when (< i len))
+               (vector-set! v i (begin body ...))
+               (add1 i))
+             v))))))
 
   (define-for-syntax (do-for/lists for/fold-id stx)
     (syntax-case stx ()
diff --git a/collects/scribblings/guide/for.scrbl b/collects/scribblings/guide/for.scrbl
index 38f6ca3..d9cae23 100644
--- a/collects/scribblings/guide/for.scrbl
+++ b/collects/scribblings/guide/for.scrbl
@@ -244,18 +244,24 @@ newly-constructed vector instead of a list:
 The @racket[for*/vector] behaves similarly, but the iterations are
 nested.
 
-The @racket[for/vector] also allows a form where the length
-of the vector to be constructed is supplied in advance.  The resulting
-iteration can be performed more efficiently than plain
-@racket[for/vector]:
+The @racket[for/vector] and @racket[for*/vector] forms also allow the
+length of the vector to be constructed to be supplied in advance.  The
+resulting iteration can be performed more efficiently than plain
+@racket[for/vector] or @racket[for*/vector]:
 
 @interaction[
 (let ((chapters '("Intro" "Details" "Conclusion")))
   (for/vector #:length (length chapters) ([i (in-naturals 1)]
-                                         [chapter chapters])
+                                          [chapter chapters])
     (string-append (number->string i) ". " chapter)))
 ]
 
+If a length is provided, the iteration stops when the vector is filled
+or the requested iterations are complete, whichever comes first.  If
+the provided length exceeds the requested number of iterations, then
+the remaining slots in the vector are initialized to the default
+argument of @racket[make-vector].
+
 @section{@racket[for/and] and @racket[for/or]}
 
 The @racket[for/and] form combines iteration results with
diff --git a/collects/scribblings/reference/for.scrbl b/collects/scribblings/reference/for.scrbl
index 9816763..b311888 100644
--- a/collects/scribblings/reference/for.scrbl
+++ b/collects/scribblings/reference/for.scrbl
@@ -92,14 +92,18 @@ expression is a list of the results in order.
 @defform*[((for*/vector (for-clause ...) body ...)
            (for*/vector #:length length-expr (for-clause ...) body ...))])]{
 
-Iterates like @scheme[for] or @scheme[for*], but last expression in
-the @scheme[body]s must produce a single value, which is placed in the
-corresponding slot of a vector whose length is the number of
-iterations.  The optional @scheme[length-expr], if present, may allow
-the computation to be performed more efficiently by pre-allocating a
-vector of the given length.  It is an error if evaluating the given
-@scheme[length-expr] does not produce a valid length for a vector that
-matches the number of iterations performed by the loop.}
+Iterates like @scheme[for] or @scheme[for*], but the last expression
+in the @scheme[body]s must produce a single value, which is placed in
+the corresponding slot of a vector.  If the optional @scheme[#:length]
+form is used, then @scheme[length-expr] must evaluate to an
+@scheme[exact-nonnegative-integer?], and the result vector is
+constructed with this length.  In this case, the iteration can be
+performed more efficiently, and terminates when the vector is full or
+the requested number of iterations have been performed, whichever
+comes first.  If the provided @scheme[length-expr] evaluates to a
+length longer than the number of iterations then the remaining slots
+of the vector are intialized to the default argument of
+@scheme[make-vector].}
 
 @deftogether[(
 @defform[(for/hash (for-clause ...) body ...+)]
diff --git a/collects/tests/racket/flonum.rktl b/collects/tests/racket/flonum.rktl
index 65e1641..3965341 100644
--- a/collects/tests/racket/flonum.rktl
+++ b/collects/tests/racket/flonum.rktl
@@ -31,10 +31,24 @@
   (test flv 'for*/flvector flv1)
   (test flv 'for*/flvector-fast flv2))
 
-;; Test failure when too many iterations
-(test #t 'for/vector-too-many-iters 
-      (with-handlers ((exn:fail? (lambda (exn) #t)))
-        (for/flvector #:length 3 ((i (in-range 4))) (+ i 1.0))))
+;; Test for both length too long and length too short
+(let ((v (make-flvector 3)))
+  (flvector-set! v 0 0.0)
+  (flvector-set! v 1 1.0)
+  (let ((w (for/flvector #:length 3 ((i (in-range 2))) (exact->inexact i))))
+    (test v 'for/flvector-short-iter w)))
+
+(let ((v (make-flvector 10)))
+  (for* ((i (in-range 3))
+         (j (in-range 3)))
+    (flvector-set! v (+ j (* i 3)) (+ 1.0 i j)))
+  (let ((w (for*/flvector #:length 10 ((i (in-range 3)) (j (in-range 3))) (+ 1.0 i j))))
+    (test v 'for*/flvector-short-iter w)))
+
+(test 2 'for/flvector-long-iter
+      (flvector-length (for/flvector #:length 2 ((i (in-range 10))) (exact->inexact i))))
+(test 5 'for*/flvector-long-iter 
+      (flvector-length (for*/flvector #:length 5 ((i (in-range 3)) (j (in-range 3))) (exact->inexact (+ i j)))))
 
 ;; Test for many body expressions
 (let* ((flv (flvector 1.0 2.0 3.0))
diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl
index 3a5b333..c4c6608 100644
--- a/collects/tests/racket/for.rktl
+++ b/collects/tests/racket/for.rktl
@@ -185,6 +185,7 @@
                            (open-input-string "1 2 3\n4 5"))])
     (list i j)))
 
+;; Basic sanity checks.
 (test '#(1 2 3 4) 'for/vector (for/vector ((i (in-range 4))) (+ i 1)))
 (test '#(1 2 3 4) 'for/vector-fast (for/vector #:length 4 ((i (in-range 4))) (+ i 1)))
 
@@ -197,10 +198,24 @@
                                                 (+ i j)
                                                 (* i j)))
 
-;; Test failure when too many iterations
-(test #t 'for/vector-too-many-iters 
-      (with-handlers ((exn:fail? (lambda (exn) #t)))
-        (for/vector #:length 3 ((i (in-range 4))) (+ i 1.0))))
+;; Test for both length too long and length too short
+(let ((v (make-vector 3)))
+  (vector-set! v 0 0)
+  (vector-set! v 1 1)
+  (let ((w (for/vector #:length 3 ((i (in-range 2))) i)))
+    (test v 'for/vector-short-iter w)))
+
+(let ((v (make-vector 10)))
+  (for* ((i (in-range 3))
+         (j (in-range 3)))
+    (vector-set! v (+ j (* i 3)) (+ i j)))
+  (let ((w (for*/vector #:length 10 ((i (in-range 3)) (j (in-range 3))) (+ i j))))
+    (test v 'for*/vector-short-iter w)))
+
+(test 2 'for/vector-long-iter
+      (vector-length (for/vector #:length 2 ((i (in-range 10))) i)))
+(test 5 'for*/vector-long-iter 
+      (vector-length (for*/vector #:length 5 ((i (in-range 3)) (j (in-range 3))) (+ i j))))
 
 ;; Test for many body expressions
 (let* ((v (vector 1.0 2.0 3.0))
-- 
1.7.2.1