From 3d016150a3e85e0b2e4999a70bc76c715db6cc12 Mon Sep 17 00:00:00 2001 From: "Will M. Farr" Date: Sat, 21 Aug 2010 01:00:04 -0500 Subject: [PATCH] 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 pre-allocate. - 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 length-expr 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 | 22 ++++++++------- collects/scribblings/reference/numbers.scrbl | 8 +++--- collects/tests/racket/flonum.rktl | 20 ++++++++++++-- collects/tests/racket/for.rktl | 24 ++++++++++++++--- 7 files changed, 82 insertions(+), 43 deletions(-) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index 9ed879be6c..36013ac4eb 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -50,24 +50,26 @@ (define-syntax for/flvector (lambda (stx) (syntax-case stx () - ((for/flvector (for-clause ...) body) + ((for/flvector (for-clause ...) body ...) (syntax/loc stx - (list->flvector (for/list (for-clause ...) body)))) - ((for/flvector len-expr (for-clause ...) body) + (list->flvector (for/list (for-clause ...) body ...)))) + ((for/flvector #:length len-expr (for-clause ...) body ...) (syntax/loc stx - (let ((flv (make-flvector len-expr))) - (for ((i (in-naturals)) - for-clause - ...) - (flvector-set! flv i body)) - flv)))))) + (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 (lambda (stx) (syntax-case stx () - ((for*/flvector (for-clause ...) body) + ((for*/flvector (for-clause ...) body ...) (syntax/loc stx - (list->flvector (for*/list (for-clause ...) body)))) - ((for*/flvector length-expr (for-clause ...) body) + (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 + (for*/flvector (for-clause ...) body ...)))))) \ No newline at end of file diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 925878d06b..6244bc2137 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -912,27 +912,28 @@ (define-syntax for/vector (lambda (stx) (syntax-case stx () - ((for/vector (for-clause ...) body) + ((for/vector (for-clause ...) body ...) (syntax/loc stx - (list->vector (for/list (for-clause ...) body)))) - ((for/vector length-expr (for-clause ...) body) + (list->vector (for/list (for-clause ...) body ...)))) + ((for/vector #:length size-expr (for-clause ...) body ...) (syntax/loc stx - (let ((len length-expr)) + (let ((len size-expr)) (let ((v (make-vector len))) (for ((i (in-naturals)) for-clause ...) - (vector-set! v i body)) + (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) + ((for*/vector (for-clause ...) body ...) (syntax/loc stx - (list->vector (for*/list (for-clause ...) body)))) - ((for*/vector length-expr (for-clause ...) body) + (list->vector (for*/list (for-clause ...) body ...)))) + ((for*/vector #:length len-expr (for-clause ...) body ...) (syntax/loc stx - (for*/vector (for-clause ...) body)))))) + (for*/vector (for-clause ...) body ...)))))) (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 85446486e5..38f6ca3d73 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 (in-naturals 1)] - [chapter chapters]) + (for/vector #:length (length chapters) ([i (in-naturals 1)] + [chapter chapters]) (string-append (number->string i) ". " chapter))) ] diff --git a/collects/scribblings/reference/for.scrbl b/collects/scribblings/reference/for.scrbl index c5a8abf076..981676334d 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 (for-clause ...) body) - (for/vector length-expr (for-clause ...) body))] -@defform*[((for*/vector (for-clause ...) body) - (for*/vector length-expr (for-clause ...) body))])]{ +@defform*[((for/vector (for-clause ...) body ...) + (for/vector #:length length-expr (for-clause ...) body ...))] +@defform*[((for*/vector (for-clause ...) body ...) + (for*/vector #:length length-expr (for-clause ...) 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[length-expr], if present, -is evaluated to determine the length of the vector in advance of the -iteration; if @scheme[length-expr] is provided, the computation is -more efficient.} +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.} @deftogether[( @defform[(for/hash (for-clause ...) body ...+)] diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index bbeb47847d..f6cf5589e2 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -1104,10 +1104,10 @@ elements of @scheme[v] efficiently as in @scheme[in-list], @scheme[in-vector], etc.} @deftogether[( -@defform*[((for/flvector (for-clause ...) body) - (for/flvector length-expr (for-clause ...) body))] -@defform*[((for*/flvector (for-clause ...) body) - (for*/flvector length-expr (for-clause ...) body))])]{ +@defform*[((for/flvector (for-clause ...) body ...) + (for/flvector #:length length-expr (for-clause ...) body ...))] +@defform*[((for*/flvector (for-clause ...) body ...) + (for*/flvector #:length length-expr (for-clause ...) 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 5b96f17563..65e1641b15 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 (in-range 3))) (+ i 1.0))) - (flv2 (for/flvector 3 ((i (in-range 3))) (+ i 1.0)))) + (flv2 (for/flvector #:length 3 ((i (in-range 3))) (+ i 1.0)))) (test flv 'for/flvector flv1) (test flv 'for/flvector-fast 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 (in-range 3)) (j (in-range 3))) (exact->inexact (* 1.0 i j)))) - (flv2 (for*/flvector 9 ((i (in-range 3)) (j (in-range 3))) (exact->inexact (* 1.0 i j))))) + (flv2 (for*/flvector #:length 9 ((i (in-range 3)) (j (in-range 3))) (exact->inexact (* 1.0 i j))))) (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 many body expressions +(let* ((flv (flvector 1.0 2.0 3.0)) + (flv2 (for/flvector ((i (in-range 3))) + (flvector-set! flv i (+ (flvector-ref flv i) 1.0)) + (flvector-ref flv i))) + (flv3 (for/flvector #:length 3 ((i (in-range 3))) + (flvector-set! flv i (+ (flvector-ref flv i) 1.0)) + (flvector-ref flv i)))) + (test (flvector 2.0 3.0 4.0) 'for/flvector-many-body flv2) + (test (flvector 3.0 4.0 5.0) 'for/flvector-length-many-body flv3)) + (report-errs) \ No newline at end of file diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index 9123a7cfd6..b04028be00 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 (in-range 4))) (+ i 1))) -(test '#(1 2 3 4) 'for/vector-fast (for/vector 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))) (test '#(0 0 0 0 1 2 0 2 4) 'for*/vector (for*/vector ((i (in-range 3)) (j (in-range 3))) + (+ i j) (* i j))) -(test '#(0 0 0 0 1 2 0 2 4) 'for*/vector-fast (for*/vector 9 ((i (in-range 3)) - (j (in-range 3))) +(test '#(0 0 0 0 1 2 0 2 4) 'for*/vector-fast (for*/vector #:length 9 ((i (in-range 3)) + (j (in-range 3))) + (+ 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 many body expressions +(let* ((v (vector 1.0 2.0 3.0)) + (v2 (for/vector ((i (in-range 3))) + (vector-set! v i (+ (vector-ref v i) 1.0)) + (vector-ref v i))) + (v3 (for/vector #:length 3 ((i (in-range 3))) + (vector-set! v i (+ (vector-ref v i) 1.0)) + (vector-ref v i)))) + (test (vector 2.0 3.0 4.0) 'for/vector-many-body v2) + (test (vector 3.0 4.0 5.0) 'for/vector-length-many-body v3)) + (test #hash((a . 1) (b . 2) (c . 3)) 'mk-hash (for/hash ([v (in-naturals)] [k '(a b c)])