suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add a #:fill' clause to for/vector' et al.

Browse Source
This commit is contained in:
Matthew Flatt 2012-08-15 09:20:42 -06:00
parent 8a26d83651
commit 6e2bb58cce
10 changed files with 95 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/fixnum.rkt
View File

@ -26,4 +26,5 @@
in-fxvector
for/fxvector
for*/fxvector
fxvector-copy)
fxvector-copy
0)

3
collects/racket/flonum.rkt
View File

@ -25,4 +25,5 @@
in-flvector
for/flvector
for*/flvector
flvector-copy)
flvector-copy
0.0)

19
collects/racket/private/for.rkt
View File

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

23
collects/racket/private/vector-wraps.rkt
View File

@ -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,7 +103,8 @@
(let ([len length-expr])
(unless (exact-nonnegative-integer? len)
(raise-argument-error 'for_/fXvector "exact-nonnegative-integer?" len))
(let ([v (make-fXvector len)])
(let ([fill fill-expr])
(let ([v (make-fXvector len fill)])
(unless (zero? len)
(for_/fold/derived
orig-stx
@ -110,13 +112,16 @@
(limited-for-clause ...)
(fXvector-set! v i (let () body ...))
(add1 i)))
v))))]))
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)

14
collects/scribblings/reference/fixnums.scrbl
View File

@ -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?]{

14
collects/scribblings/reference/flonums.scrbl
View File

@ -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?]{

40
collects/scribblings/reference/for.scrbl
View File

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

7
collects/tests/racket/flonum.rktl
View File

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

5
collects/tests/racket/for.rktl
View File

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

2
doc/release-notes/racket/HISTORY.txt
View File

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