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.
This commit is contained in:
Will M. Farr 2010-08-23 09:22:58 -05:00 committed by Sam Tobin-Hochstadt
parent 3d016150a3
commit 81b1ed6e8b
6 changed files with 132 additions and 70 deletions

View File

@ -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 ...))))))
(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))))))

View File

@ -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 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
(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-for-syntax (do-for/lists for/fold-id stx)
(syntax-case stx ()

View File

@ -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

View File

@ -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 ...+)]

View File

@ -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))

View File

@ -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))