From 0dd84aad2e65c052abdc5b5fa3c86fbf2bbba94b Mon Sep 17 00:00:00 2001
From: Will M. Farr
Date: Sat, 21 Aug 2010 01:00:04 0500
Subject: [PATCH 2/3] Updates to for/vector, for/flvector forms and documentation.
 Now the faster forms take a #:length keyword to designate the length
of the vector to preallocate.
 The for/[fl]vector forms take multiple body expressions and set the
vector component to the value of the last one.
 When given a #:length argument, the for/vector and for/flvector
forms check that the iteration is not exceeding the given length,
raising exn:fail if it does.
 Test cases for the multiple body expressions and the exception for
excessive iterations have been added.
 Doc modifications to bring the docs in line with the new forms.
 Doc modifications to note that the #:length versions of the form
*may* all the computation to be performed more efficiently, and
stating that it "is an error" if the given lengthexpr does not
produce a valid length for a vector that matches the number of
iterations for the loop.
 Note that no test is made for a number of loop iterations that is
smaller than the given vector length. Also, the for*/[fl]vector
forms do not optimize when given a #:length argument. These are
areas for future improvement.

collects/racket/flonum.rkt  28 +++++++++++++
collects/racket/private/for.rkt  19 +++++++++
collects/scribblings/guide/for.scrbl  4 +
collects/scribblings/reference/for.scrbl  24 ++++++++++++
collects/scribblings/reference/numbers.scrbl  8 +++
collects/tests/racket/flonum.rktl  20 ++++++++++++++++
collects/tests/racket/for.rktl  24 +++++++++++++++++++
7 files changed, 83 insertions(+), 44 deletions()
diff git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt
index cb2ad54..7cb0abd 100644
 a/collects/racket/flonum.rkt
+++ b/collects/racket/flonum.rkt
@@ 50,24 +50,26 @@
(definesyntax for/flvector
(lambda (stx)
(syntaxcase stx ()
 ((for/flvector (forclause ...) body)
+ ((for/flvector (forclause ...) body ...)
(syntax/loc stx
 (list>flvector (for/list (forclause ...) body))))
 ((for/flvector lenexpr (forclause ...) body)
+ (list>flvector (for/list (forclause ...) body ...))))
+ ((for/flvector #:length lenexpr (forclause ...) body ...)
(syntax/loc stx
 (let ((flv (makeflvector lenexpr)))
 (for ((i (innaturals))
 forclause
 ...)
 (flvectorset! flv i body))
 flv))))))
+ (let ((len lenexpr))
+ (let ((flv (makeflvector len)))
+ (for ((i (innaturals))
+ forclause
+ ...)
+ (when (fx>= i len) (error 'for/flvector "too many iterations for vector of length ~a" len))
+ (flvectorset! flv i (begin body ...)))
+ flv)))))))
(definesyntax for*/flvector
(lambda (stx)
(syntaxcase stx ()
 ((for*/flvector (forclause ...) body)
+ ((for*/flvector (forclause ...) body ...)
(syntax/loc stx
 (list>flvector (for*/list (forclause ...) body))))
 ((for*/flvector lengthexpr (forclause ...) body)
+ (list>flvector (for*/list (forclause ...) body ...))))
+ ((for*/flvector #:length lenexpr (forclause ...) body ...)
(syntax/loc stx
 (for*/flvector (forclause ...) body))))))
\ No newline at end of file
+ (for*/flvector (forclause ...) body ...))))))
\ No newline at end of file
diff git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt
index 5cd1771..3a06c1f 100644
 a/collects/racket/private/for.rkt
+++ b/collects/racket/private/for.rkt
@@ 912,27 +912,28 @@
(definesyntax for/vector
(lambda (stx)
(syntaxcase stx ()
 ((for/vector (forclause ...) body)
+ ((for/vector (forclause ...) body ...)
(syntax/loc stx
 (list>vector (for/list (forclause ...) body))))
 ((for/vector lengthexpr (forclause ...) body)
+ (list>vector (for/list (forclause ...) body ...))))
+ ((for/vector #:length sizeexpr (forclause ...) body ...)
(syntax/loc stx
 (let ((len lengthexpr))
+ (let ((len sizeexpr))
(let ((v (makevector len)))
(for ((i (innaturals))
forclause ...)
 (vectorset! v i body))
+ (when (>= i len) (error 'for/vector "too many iterations for vector of length ~a" len))
+ (vectorset! v i (begin body ...)))
v)))))))
(definesyntax for*/vector
(lambda (stx)
(syntaxcase stx ()
 ((for*/vector (forclause ...) body)
+ ((for*/vector (forclause ...) body ...)
(syntax/loc stx
 (list>vector (for*/list (forclause ...) body))))
 ((for*/vector lengthexpr (forclause ...) body)
+ (list>vector (for*/list (forclause ...) body ...))))
+ ((for*/vector #:length lenexpr (forclause ...) body ...)
(syntax/loc stx
 (for*/vector (forclause ...) body))))))
+ (for*/vector (forclause ...) body ...))))))
(defineforsyntax (dofor/lists for/foldid stx)
(syntaxcase stx ()
diff git a/collects/scribblings/guide/for.scrbl b/collects/scribblings/guide/for.scrbl
index 8544648..38f6ca3 100644
 a/collects/scribblings/guide/for.scrbl
+++ b/collects/scribblings/guide/for.scrbl
@@ 251,8 +251,8 @@ iteration can be performed more efficiently than plain
@interaction[
(let ((chapters '("Intro" "Details" "Conclusion")))
 (for/vector (length chapters) ([i (innaturals 1)]
 [chapter chapters])
+ (for/vector #:length (length chapters) ([i (innaturals 1)]
+ [chapter chapters])
(stringappend (number>string i) ". " chapter)))
]
diff git a/collects/scribblings/reference/for.scrbl b/collects/scribblings/reference/for.scrbl
index c5a8abf..9816763 100644
 a/collects/scribblings/reference/for.scrbl
+++ b/collects/scribblings/reference/for.scrbl
@@ 87,17 +87,19 @@ expression is a list of the results in order.
]}
@deftogether[(
@defform*[((for/vector (forclause ...) body)
 (for/vector lengthexpr (forclause ...) body))]
@defform*[((for*/vector (forclause ...) body)
 (for*/vector lengthexpr (forclause ...) body))])]{

Iterates like @scheme[for] or @scheme[for*], but the values of the
@scheme[body] expression are placed in a vector whose length is the
number of iterations. The optional @scheme[lengthexpr], if present,
is evaluated to determine the length of the vector in advance of the
iteration; if @scheme[lengthexpr] is provided, the computation is
more efficient.}
+@defform*[((for/vector (forclause ...) body ...)
+ (for/vector #:length lengthexpr (forclause ...) body ...))]
+@defform*[((for*/vector (forclause ...) body ...)
+ (for*/vector #:length lengthexpr (forclause ...) 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[lengthexpr], if present, may allow
+the computation to be performed more efficiently by preallocating a
+vector of the given length. It is an error if evaluating the given
+@scheme[lengthexpr] does not produce a valid length for a vector that
+matches the number of iterations performed by the loop.}
@deftogether[(
@defform[(for/hash (forclause ...) body ...+)]
diff git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl
index 6509be7..b35837d 100644
 a/collects/scribblings/reference/numbers.scrbl
+++ b/collects/scribblings/reference/numbers.scrbl
@@ 1100,10 +1100,10 @@ elements of @scheme[v] efficiently as in @scheme[inlist],
@scheme[invector], etc.}
@deftogether[(
@defform*[((for/flvector (forclause ...) body)
 (for/flvector lengthexpr (forclause ...) body))]
@defform*[((for*/flvector (forclause ...) body)
 (for*/flvector lengthexpr (forclause ...) body))])]{
+@defform*[((for/flvector (forclause ...) body ...)
+ (for/flvector #:length lengthexpr (forclause ...) body ...))]
+@defform*[((for*/flvector (forclause ...) body ...)
+ (for*/flvector #:length lengthexpr (forclause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{flvector}s.}
diff git a/collects/tests/racket/flonum.rktl b/collects/tests/racket/flonum.rktl
index 5b96f17..65e1641 100644
 a/collects/tests/racket/flonum.rktl
+++ b/collects/tests/racket/flonum.rktl
@@ 20,15 +20,31 @@
;; for/flvector test
(let ((flv (flvector 1.0 2.0 3.0))
(flv1 (for/flvector ((i (inrange 3))) (+ i 1.0)))
 (flv2 (for/flvector 3 ((i (inrange 3))) (+ i 1.0))))
+ (flv2 (for/flvector #:length 3 ((i (inrange 3))) (+ i 1.0))))
(test flv 'for/flvector flv1)
(test flv 'for/flvectorfast flv2))
;; for*/flvector test
(let ((flv (flvector 0.0 0.0 0.0 0.0 1.0 2.0 0.0 2.0 4.0))
(flv1 (for*/flvector ((i (inrange 3)) (j (inrange 3))) (exact>inexact (* 1.0 i j))))
 (flv2 (for*/flvector 9 ((i (inrange 3)) (j (inrange 3))) (exact>inexact (* 1.0 i j)))))
+ (flv2 (for*/flvector #:length 9 ((i (inrange 3)) (j (inrange 3))) (exact>inexact (* 1.0 i j)))))
(test flv 'for*/flvector flv1)
(test flv 'for*/flvectorfast flv2))
+;; Test failure when too many iterations
+(test #t 'for/vectortoomanyiters
+ (withhandlers ((exn:fail? (lambda (exn) #t)))
+ (for/flvector #:length 3 ((i (inrange 4))) (+ i 1.0))))
+
+;; Test for many body expressions
+(let* ((flv (flvector 1.0 2.0 3.0))
+ (flv2 (for/flvector ((i (inrange 3)))
+ (flvectorset! flv i (+ (flvectorref flv i) 1.0))
+ (flvectorref flv i)))
+ (flv3 (for/flvector #:length 3 ((i (inrange 3)))
+ (flvectorset! flv i (+ (flvectorref flv i) 1.0))
+ (flvectorref flv i))))
+ (test (flvector 2.0 3.0 4.0) 'for/flvectormanybody flv2)
+ (test (flvector 3.0 4.0 5.0) 'for/flvectorlengthmanybody flv3))
+
(reporterrs)
\ No newline at end of file
diff git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl
index 2780ce2..3a5b333 100644
 a/collects/tests/racket/for.rktl
+++ b/collects/tests/racket/for.rktl
@@ 186,15 +186,33 @@
(list i j)))
(test '#(1 2 3 4) 'for/vector (for/vector ((i (inrange 4))) (+ i 1)))
(test '#(1 2 3 4) 'for/vectorfast (for/vector 4 ((i (inrange 4))) (+ i 1)))
+(test '#(1 2 3 4) 'for/vectorfast (for/vector #:length 4 ((i (inrange 4))) (+ i 1)))
(test '#(0 0 0 0 1 2 0 2 4) 'for*/vector (for*/vector ((i (inrange 3))
(j (inrange 3)))
+ (+ i j)
(* i j)))
(test '#(0 0 0 0 1 2 0 2 4) 'for*/vectorfast (for*/vector 9 ((i (inrange 3))
 (j (inrange 3)))
+(test '#(0 0 0 0 1 2 0 2 4) 'for*/vectorfast (for*/vector #:length 9 ((i (inrange 3))
+ (j (inrange 3)))
+ (+ i j)
(* i j)))
+;; Test failure when too many iterations
+(test #t 'for/vectortoomanyiters
+ (withhandlers ((exn:fail? (lambda (exn) #t)))
+ (for/vector #:length 3 ((i (inrange 4))) (+ i 1.0))))
+
+;; Test for many body expressions
+(let* ((v (vector 1.0 2.0 3.0))
+ (v2 (for/vector ((i (inrange 3)))
+ (vectorset! v i (+ (vectorref v i) 1.0))
+ (vectorref v i)))
+ (v3 (for/vector #:length 3 ((i (inrange 3)))
+ (vectorset! v i (+ (vectorref v i) 1.0))
+ (vectorref v i))))
+ (test (vector 2.0 3.0 4.0) 'for/vectormanybody v2)
+ (test (vector 3.0 4.0 5.0) 'for/vectorlengthmanybody v3))
+
(test #hash((a . 1) (b . 2) (c . 3)) 'mkhash
(for/hash ([v (innaturals)]
[k '(a b c)])

1.7.2.1