From 6e2bb58cceec6be007f99d024cc0a8a5b0bbff1a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 15 Aug 2012 09:20:42 -0600 Subject: [PATCH] add a `#:fill' clause to `for/vector' et al. --- collects/racket/fixnum.rkt | 3 +- collects/racket/flonum.rkt | 3 +- collects/racket/private/for.rkt | 19 ++++++---- collects/racket/private/vector-wraps.rkt | 37 ++++++++++-------- collects/scribblings/reference/fixnums.scrbl | 14 ++++--- collects/scribblings/reference/flonums.scrbl | 20 ++++++---- collects/scribblings/reference/for.scrbl | 40 ++++++++++++-------- collects/tests/racket/flonum.rktl | 7 ++++ collects/tests/racket/for.rktl | 5 ++- doc/release-notes/racket/HISTORY.txt | 2 + 10 files changed, 95 insertions(+), 55 deletions(-) diff --git a/collects/racket/fixnum.rkt b/collects/racket/fixnum.rkt index 39bd61e3df..c38da67528 100644 --- a/collects/racket/fixnum.rkt +++ b/collects/racket/fixnum.rkt @@ -26,4 +26,5 @@ in-fxvector for/fxvector for*/fxvector - fxvector-copy) + fxvector-copy + 0) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index 7fce7b9b04..bfa03477b0 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -25,4 +25,5 @@ in-flvector for/flvector for*/flvector - flvector-copy) + flvector-copy + 0.0) diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index b437968b1f..2f466d9f69 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -1368,10 +1368,10 @@ (vector-copy! new-vec 0 vec 0 i) new-vec) - (define-for-syntax (for_/vector stx for_/vector-stx for_/fold/derived-stx wrap-all?) + (define-for-syntax (for_/vector stx orig-stx for_/vector-stx for_/fold/derived-stx wrap-all?) (syntax-case stx () [(_ (for-clause ...) body ...) - (with-syntax ([orig-stx stx] + (with-syntax ([orig-stx orig-stx] [for_/fold/derived for_/fold/derived-stx]) (syntax/loc stx (let-values ([(vec i) @@ -1386,8 +1386,8 @@ (unsafe-vector-set! new-vec i (let () body ...)) (values new-vec (unsafe-fx+ i 1))))]) (shrink-vector vec i))))] - [(_ #:length length-expr (for-clause ...) body ...) - (with-syntax ([orig-stx stx] + [(_ #:length length-expr #:fill fill-expr (for-clause ...) body ...) + (with-syntax ([orig-stx orig-stx] [(limited-for-clause ...) ;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap ;; only the first and the first after each keyword clause: @@ -1421,7 +1421,7 @@ (let ([len length-expr]) (unless (exact-nonnegative-integer? len) (raise-argument-error 'for_/vector "exact-nonnegative-integer?" len)) - (let ([v (make-vector len)]) + (let ([v (make-vector len fill-expr)]) (unless (zero? len) (for_/fold/derived orig-stx @@ -1429,13 +1429,16 @@ (limited-for-clause ...) (vector-set! v i (let () body ...)) (add1 i))) - v))))])) + v))))] + [(_ #:length length-expr (for-clause ...) body ...) + (for_/vector #'(fv #:length length-expr #:fill 0 (for-clause ...) body ...) + orig-stx for_/vector-stx for_/fold/derived-stx wrap-all?)])) (define-syntax (for/vector stx) - (for_/vector stx #'for/vector #'for/fold/derived #f)) + (for_/vector stx stx #'for/vector #'for/fold/derived #f)) (define-syntax (for*/vector stx) - (for_/vector stx #'for*/vector #'for*/fold/derived #t)) + (for_/vector stx stx #'for*/vector #'for*/fold/derived #t)) (define-for-syntax (do-for/lists for/fold-id stx) (syntax-case stx () diff --git a/collects/racket/private/vector-wraps.rkt b/collects/racket/private/vector-wraps.rkt index ae0124c535..1baee63315 100644 --- a/collects/racket/private/vector-wraps.rkt +++ b/collects/racket/private/vector-wraps.rkt @@ -15,7 +15,8 @@ in-fXvector for/fXvector for*/fXvector - fXvector-copy) + fXvector-copy + fXzero) (... (begin (define-:vector-like-gen :fXvector-gen unsafe-fXvector-ref) @@ -49,10 +50,10 @@ (unsafe-fXvector-copy! new-vec 0 vec 0 i) new-vec) - (define-for-syntax (for_/fXvector stx for_/fXvector-stx for_/fold/derived-stx wrap-all?) + (define-for-syntax (for_/fXvector stx orig-stx for_/fXvector-stx for_/fold/derived-stx wrap-all?) (syntax-case stx () [(for*/fXvector (for-clause ...) body ...) - (with-syntax ([orig-stx stx] + (with-syntax ([orig-stx orig-stx] [for_/fold/derived for_/fold/derived-stx]) (syntax/loc stx (let-values ([(vec i) @@ -67,8 +68,8 @@ (unsafe-fXvector-set! new-vec i (let () body ...)) (values new-vec (unsafe-fx+ i 1))))]) (shrink-fXvector vec i))))] - [(for*/fXvector #:length length-expr (for-clause ...) body ...) - (with-syntax ([orig-stx stx] + [(for*/fXvector #:length length-expr #:fill fill-expr (for-clause ...) body ...) + (with-syntax ([orig-stx orig-stx] [(limited-for-clause ...) ;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap ;; only the first and the first after each keyword clause: @@ -102,21 +103,25 @@ (let ([len length-expr]) (unless (exact-nonnegative-integer? len) (raise-argument-error 'for_/fXvector "exact-nonnegative-integer?" len)) - (let ([v (make-fXvector len)]) - (unless (zero? len) - (for_/fold/derived - orig-stx - ([i 0]) - (limited-for-clause ...) - (fXvector-set! v i (let () body ...)) - (add1 i))) - v))))])) + (let ([fill fill-expr]) + (let ([v (make-fXvector len fill)]) + (unless (zero? len) + (for_/fold/derived + orig-stx + ([i 0]) + (limited-for-clause ...) + (fXvector-set! v i (let () body ...)) + (add1 i))) + v)))))] + [(_ #:length length-expr (for-clause ...) body ...) + (for_/fXvector #'(fv #:length length-expr #:fill fXzero (for-clause ...) body ...) + orig-stx for_/fXvector-stx for_/fold/derived-stx wrap-all?)])) (define-syntax (for/fXvector stx) - (for_/fXvector stx #'for/fXvector #'for/fold/derived #f)) + (for_/fXvector stx stx #'for/fXvector #'for/fold/derived #f)) (define-syntax (for*/fXvector stx) - (for_/fXvector stx #'for*/fXvector #'for*/fold/derived #t)) + (for_/fXvector stx stx #'for*/fXvector #'for*/fold/derived #t)) (define (fXvector-copy flv [start 0] [end (and (fXvector? flv) (fXvector-length flv))]) (unless (fXvector? flv) diff --git a/collects/scribblings/reference/fixnums.scrbl b/collects/scribblings/reference/fixnums.scrbl index a8af31cea6..2b5f75c27a 100644 --- a/collects/scribblings/reference/fixnums.scrbl +++ b/collects/scribblings/reference/fixnums.scrbl @@ -169,13 +169,17 @@ elements of @racket[vec] from @racket[start] (inclusive) to } @deftogether[( -@defform*[((for/fxvector (for-clause ...) body ...) - (for/fxvector #:length length-expr (for-clause ...) body ...))] -@defform*[((for*/fxvector (for-clause ...) body ...) - (for*/fxvector #:length length-expr (for-clause ...) body ...))])]{ +@defform[(for/fxvector maybe-length (for-clause ...) body ...)] +@defform/subs[(for*/fxvector maybe-length (for-clause ...) body ...) + ([maybe-length (code:line) + (code:line #:length length-expr) + (code:line #:length length-expr #:fill fill-expr)]) + #:contracts ([length-expr exact-nonnegative-integer?] + [fill-expr fixnum?])] +)]{ Like @racket[for/vector] or @racket[for*/vector], but for -@tech{fxvector}s.} +@tech{fxvector}s. The default @racket[fill-expr] produces @racket[0].} @defproc[(shared-fxvector [x fixnum?] ...) fxvector?]{ diff --git a/collects/scribblings/reference/flonums.scrbl b/collects/scribblings/reference/flonums.scrbl index 3087e27d7f..07458ea7c4 100644 --- a/collects/scribblings/reference/flonums.scrbl +++ b/collects/scribblings/reference/flonums.scrbl @@ -202,9 +202,9 @@ elements of @racket[vec] from @racket[start] (inclusive) to @defproc[(in-flvector [vec flvector?] - [start exact-nonnegative-integer? 0] - [stop (or/c exact-integer? #f) #f] - [step (and/c exact-integer? (not/c zero?)) 1]) + [start exact-nonnegative-integer? 0] + [stop (or/c exact-integer? #f) #f] + [step (and/c exact-integer? (not/c zero?)) 1]) sequence?]{ Returns a sequence equivalent to @racket[vec] when no optional arguments are supplied. @@ -217,13 +217,17 @@ elements of @racket[vec] from @racket[start] (inclusive) to } @deftogether[( -@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 ...))])]{ +@defform[(for/flvector maybe-length (for-clause ...) body ...)] +@defform/subs[(for*/flvector maybe-length (for-clause ...) body ...) + ([maybe-length (code:line) + (code:line #:length length-expr) + (code:line #:length length-expr #:fill fill-expr)]) + #:contracts ([length-expr exact-nonnegative-integer?] + [fill-expr flonum?])] +)]{ Like @racket[for/vector] or @racket[for*/vector], but for -@tech{flvector}s.} +@tech{flvector}s. The default @racket[fill-expr] produces @racket[0.0].} @defproc[(shared-flvector [x flonum?] ...) flvector?]{ diff --git a/collects/scribblings/reference/for.scrbl b/collects/scribblings/reference/for.scrbl index 87f64fbba8..22e4ad70bc 100644 --- a/collects/scribblings/reference/for.scrbl +++ b/collects/scribblings/reference/for.scrbl @@ -94,20 +94,31 @@ element. (error "doesn't get here")) ]} -@defform*[((for/vector (for-clause ...) body ...+) - (for/vector #:length length-expr (for-clause ...) body ...+))]{ +@defform/subs[(for/vector maybe-length (for-clause ...) body ...+) + ([maybe-length (code:line) + (code:line #:length length-expr) + (code:line #:length length-expr #:fill fill-expr)]) + #:contracts ([length-expr exact-nonnegative-integer?])]{ -Iterates like @racket[for/list], but the result are accumulated into -a vector instead of a list. If the optional @racket[#:length] -form is used, then @racket[length-expr] must evaluate to an -@racket[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 @racket[length-expr] evaluates to a -length longer than the number of iterations then the remaining slots -of the vector are initialized to the default argument of -@racket[make-vector].} +Iterates like @racket[for/list], but results are accumulated into +a vector instead of a list. + +If the optional @racket[#:length] clause is specified, the result of +@racket[length-expr] determines the length of the result vector. In +that case, the iteration can be performed more efficiently, and it +terminates when the vector is full or the requested number of +iterations have been performed, whichever comes first. If +@racket[length-expr] specifies a length longer than the number of +iterations, then the remaining slots of the vector are initialized to +the value of @racket[fill-expr], which defaults to @racket[0] (i.e., +the default argument of @racket[make-vector]). + +@examples[ +(for/vector ([i '(1 2 3)]) (number->string i)) +(for/vector #:length 2 ([i '(1 2 3)]) (number->string i)) +(for/vector #:length 4 ([i '(1 2 3)]) (number->string i)) +(for/vector #:length 4 #:fill "?" ([i '(1 2 3)]) (number->string i)) +]} @deftogether[( @defform[(for/hash (for-clause ...) body ...+)] @@ -258,8 +269,7 @@ nested. @deftogether[( @defform[(for*/list (for-clause ...) body ...+)] @defform[(for*/lists (id ...) (for-clause ...) body ...+)] -@defform*[((for*/vector (for-clause ...) body ...+) - (for*/vector #:length length-expr (for-clause ...) body ...+))] +@defform[(for*/vector maybe-length (for-clause ...) body ...+)] @defform[(for*/hash (for-clause ...) body ...+)] @defform[(for*/hasheq (for-clause ...) body ...+)] @defform[(for*/hasheqv (for-clause ...) body ...+)] diff --git a/collects/tests/racket/flonum.rktl b/collects/tests/racket/flonum.rktl index 50ca3d89de..236e265762 100644 --- a/collects/tests/racket/flonum.rktl +++ b/collects/tests/racket/flonum.rktl @@ -25,6 +25,13 @@ (test flv 'for/flvector flv1) (test flv 'for/flvector-fast flv2)) +(test (flvector 1.0 2.0 3.0 0.0 0.0) + 'for/flvector-fill + (for/flvector #:length 5 ([i 3]) (+ i 1.0))) +(test (flvector 1.0 2.0 3.0 -10.0 -10.0) + 'for/flvector-fill + (for/flvector #:length 5 #:fill -10.0 ([i 3]) (+ i 1.0))) + ;; 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)))) diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index 6b036df324..7ce36c080c 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -159,6 +159,8 @@ ;; 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))) +(test '#(1 2 3 4 0 0) 'for/vector-fast (for/vector #:length 6 ((i (in-range 4))) (+ i 1))) +(test '#(1 2 3 4 #f #f) 'for/vector-fast (for/vector #:length 6 #:fill #f ((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))) @@ -270,9 +272,10 @@ #:unless #f [y (in-range 3)]) (+ x y))) -(test (vector 1 2 3 0 0) +(test (vector 1 2 3 -1 -1) 'unless-... (for/vector #:length 5 + #:fill -1 ([x (in-range 3)] #:unless (even? x) [y (in-range 3)]) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 257440afe8..955b94b67c 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -2,6 +2,8 @@ Version 5.3.0.20 Added exn:break:hang-up and exn:break:terminate, added extra argument to break-thread and place-break, and redirect SIGTERM and SIGHUP as breaks +Add #:fill option to for/vector, for*/vector, for/flvector, + for*/flvector, for/fxvector, and for*/fxvector Version 5.3.0.16 scribble/base: add items/c