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)) (flvector-set! v i x))
v))) v)))
(define-syntax for/flvector (define-syntax (for/flvector stx)
(lambda (stx) (syntax-case stx ()
(syntax-case stx () ((for/flvector (for-clause ...) body ...)
((for/flvector (for-clause ...) body ...) (syntax/loc stx
(syntax/loc stx (list->flvector
(list->flvector (for/list (for-clause ...) body ...)))) (for/list (for-clause ...) body ...))))
((for/flvector #:length len-expr (for-clause ...) body ...) ((for/flvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(let ((len len-expr)) (let ((len length-expr))
(let ((flv (make-flvector len))) (unless (exact-nonnegative-integer? len)
(for ((i (in-naturals)) (raise-type-error 'for/flvector "exact nonnegative integer" len))
for-clause (let ((v (make-flvector len)))
...) (for/fold ((i 0))
(when (fx>= i len) (error 'for/flvector "too many iterations for vector of length ~a" len)) (for-clause ...
(flvector-set! flv i (begin body ...))) #:when (< i len))
flv))))))) (flvector-set! v i (begin body ...))
(add1 i))
v))))))
(define-syntax for*/flvector (define-syntax (for*/flvector stx)
(lambda (stx) (syntax-case stx ()
(syntax-case stx () ((for*/flvector (for-clause ...) body ...)
((for*/flvector (for-clause ...) body ...) (syntax/loc stx
(syntax/loc stx (list->flvector
(list->flvector (for*/list (for-clause ...) body ...)))) (for*/list (for-clause ...) body ...))))
((for*/flvector #:length len-expr (for-clause ...) body ...) ((for*/flvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(for*/flvector (for-clause ...) body ...)))))) (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) x)
(lambda (x) `(,#'cons ,x ,#'fold-var))) (lambda (x) `(,#'cons ,x ,#'fold-var)))
(define-syntax for/vector (define-syntax (for/vector stx)
(lambda (stx) (syntax-case stx ()
(syntax-case stx () ((for/vector (for-clause ...) body ...)
((for/vector (for-clause ...) body ...) (syntax/loc stx
(syntax/loc stx (list->vector
(list->vector (for/list (for-clause ...) body ...)))) (for/list (for-clause ...) body ...))))
((for/vector #:length size-expr (for-clause ...) body ...) ((for/vector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(let ((len size-expr)) (let ((len length-expr))
(let ((v (make-vector len))) (unless (exact-nonnegative-integer? len)
(for ((i (in-naturals)) (raise-type-error 'for/vector "exact nonnegative integer" len))
for-clause ...) (let ((v (make-vector len)))
(when (>= i len) (error 'for/vector "too many iterations for vector of length ~a" len)) (for/fold ((i 0))
(vector-set! v i (begin body ...))) (for-clause ...
v))))))) #:when (< i len))
(vector-set! v i (begin body ...))
(add1 i))
v))))))
(define-syntax for*/vector (define-syntax (for*/vector stx)
(lambda (stx) (syntax-case stx ()
(syntax-case stx () ((for*/vector (for-clause ...) body ...)
((for*/vector (for-clause ...) body ...) (syntax/loc stx
(syntax/loc stx (list->vector
(list->vector (for*/list (for-clause ...) body ...)))) (for*/list (for-clause ...) body ...))))
((for*/vector #:length len-expr (for-clause ...) body ...) ((for*/vector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(for*/vector (for-clause ...) body ...)))))) (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) (define-for-syntax (do-for/lists for/fold-id stx)
(syntax-case 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 The @racket[for*/vector] behaves similarly, but the iterations are
nested. nested.
The @racket[for/vector] also allows a form where the length The @racket[for/vector] and @racket[for*/vector] forms also allow the
of the vector to be constructed is supplied in advance. The resulting length of the vector to be constructed to be supplied in advance. The
iteration can be performed more efficiently than plain resulting iteration can be performed more efficiently than plain
@racket[for/vector]: @racket[for/vector] or @racket[for*/vector]:
@interaction[ @interaction[
(let ((chapters '("Intro" "Details" "Conclusion"))) (let ((chapters '("Intro" "Details" "Conclusion")))
(for/vector #:length (length chapters) ([i (in-naturals 1)] (for/vector #:length (length chapters) ([i (in-naturals 1)]
[chapter chapters]) [chapter chapters])
(string-append (number->string i) ". " chapter))) (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]} @section{@racket[for/and] and @racket[for/or]}
The @racket[for/and] form combines iteration results with 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 ...) @defform*[((for*/vector (for-clause ...) body ...)
(for*/vector #:length length-expr (for-clause ...) body ...))])]{ (for*/vector #:length length-expr (for-clause ...) body ...))])]{
Iterates like @scheme[for] or @scheme[for*], but last expression in Iterates like @scheme[for] or @scheme[for*], but the last expression
the @scheme[body]s must produce a single value, which is placed in the in the @scheme[body]s must produce a single value, which is placed in
corresponding slot of a vector whose length is the number of the corresponding slot of a vector. If the optional @scheme[#:length]
iterations. The optional @scheme[length-expr], if present, may allow form is used, then @scheme[length-expr] must evaluate to an
the computation to be performed more efficiently by pre-allocating a @scheme[exact-nonnegative-integer?], and the result vector is
vector of the given length. It is an error if evaluating the given constructed with this length. In this case, the iteration can be
@scheme[length-expr] does not produce a valid length for a vector that performed more efficiently, and terminates when the vector is full or
matches the number of iterations performed by the loop.} 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[( @deftogether[(
@defform[(for/hash (for-clause ...) body ...+)] @defform[(for/hash (for-clause ...) body ...+)]

View File

@ -31,10 +31,24 @@
(test flv 'for*/flvector flv1) (test flv 'for*/flvector flv1)
(test flv 'for*/flvector-fast flv2)) (test flv 'for*/flvector-fast flv2))
;; Test failure when too many iterations ;; Test for both length too long and length too short
(test #t 'for/vector-too-many-iters (let ((v (make-flvector 3)))
(with-handlers ((exn:fail? (lambda (exn) #t))) (flvector-set! v 0 0.0)
(for/flvector #:length 3 ((i (in-range 4))) (+ i 1.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 ;; Test for many body expressions
(let* ((flv (flvector 1.0 2.0 3.0)) (let* ((flv (flvector 1.0 2.0 3.0))

View File

@ -185,6 +185,7 @@
(open-input-string "1 2 3\n4 5"))]) (open-input-string "1 2 3\n4 5"))])
(list i j))) (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 (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))) (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)
(* i j))) (* i j)))
;; Test failure when too many iterations ;; Test for both length too long and length too short
(test #t 'for/vector-too-many-iters (let ((v (make-vector 3)))
(with-handlers ((exn:fail? (lambda (exn) #t))) (vector-set! v 0 0)
(for/vector #:length 3 ((i (in-range 4))) (+ i 1.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 ;; Test for many body expressions
(let* ((v (vector 1.0 2.0 3.0)) (let* ((v (vector 1.0 2.0 3.0))