From 81b1ed6e8b5e7c9e349469aed77f035d9e4b1ef4 Mon Sep 17 00:00:00 2001 From: "Will M. Farr" Date: Mon, 23 Aug 2010 09:22:58 -0500 Subject: [PATCH] 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 | 60 +++++++++++++---------- 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, 132 insertions(+), 70 deletions(-) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index 36013ac4eb..e8275e2140 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 6244bc2137..1fd601a8c8 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 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 () diff --git a/collects/scribblings/guide/for.scrbl b/collects/scribblings/guide/for.scrbl index 38f6ca3d73..d9cae23497 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 981676334d..b3118883bc 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 65e1641b15..39653410b4 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 b04028be00..bcd35ec4ba 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))