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

Added interation forms for/vector, for*/vector, for/flvector, and for*/flvector and for-clause in-flvector.

Browse Source
This commit is contained in:
Will M. Farr 2010-08-19 10:23:52 -05:00 committed by Sam Tobin-Hochstadt
parent 44b34c37a8
commit 82096abb1b
8 changed files with 190 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/racket/flonum.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang scheme
(require '#%flfxnum)
(provide fl+ fl- fl* fl/
@ -9,4 +9,65 @@
->fl fl->exact-integer
flvector? flvector make-flvector
flvector-length flvector-ref flvector-set!
flreal-part flimag-part make-flrectangular)
flreal-part flimag-part make-flrectangular
in-flvector for/flvector for*/flvector)
(define (in-flvector* flv)
(let ((n (flvector-length flv)))
(make-do-sequence
(lambda ()
(values (lambda (i) (flvector-ref flv i))
add1
0
(lambda (i) (fx< i n))
(lambda (x) #t)
(lambda (i x) #t))))))
(define-sequence-syntax in-flvector
(lambda () (syntax in-flvector*))
(lambda (stx)
(syntax-case stx ()
(((x) (in-flvector flv-expr))
(syntax/loc stx
(() (:do-in (((v) flv-expr))
(when (not (flvector? v))
(error 'in-flvector "expecting a flvector, got ~a" v))
((i 0) (n (flvector-length v)))
(fx< i n)
(((x) (flvector-ref v i)))
#t
#t
((add1 i) n))))))))
(define (list->flvector l)
(let ((n (length l)))
(let ((v (make-flvector n)))
(for ((i (in-range n))
(x (in-list l)))
(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 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))))))
(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-expr (for-clause ...) body)
(syntax/loc stx
(for*/flvector (for-clause ...) body))))))

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

@ -15,6 +15,7 @@
(#%provide for/fold for*/fold
for for*
for/list for*/list
for/vector for*/vector
for/lists for*/lists
for/and for*/and
for/or for*/or
@ -908,6 +909,31 @@
(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-expr (for-clause ...) body)
(syntax/loc stx
(let ((len length-expr))
(let ((v (make-vector len)))
(for ((i (in-naturals))
for-clause ...)
(vector-set! v i body))
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-expr (for-clause ...) body)
(syntax/loc stx
(for*/vector (for-clause ...) body))))))
(define-for-syntax (do-for/lists for/fold-id stx)
(syntax-case stx ()
[(_ (id ...) bindings expr1 expr ...)

27
collects/scribblings/guide/for.scrbl
View File

@ -229,6 +229,33 @@ list of lists, instead of one flattened list. Much like
@racket[#:when], then, the nesting of @racket[for*/list] is more
useful than the nesting of @racket[for*].
@section{@racket[for/vector] and @racket[for*/vector]}
The @racket[for/vector] form can be used with the same syntax as the
@racket[for/list] form, but the evaluated @racket[_body]s go into a
newly-constructed vector instead of a list:
@interaction[
(for/vector ([i (in-naturals 1)]
[chapter '("Intro" "Details" "Conclusion")])
(string-append (number->string i) ". " chapter))
]
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]:
@interaction[
(let ((chapters '("Intro" "Details" "Conclusion")))
(for/vector (length chapters) ([i (in-naturals 1)]
[chapter chapters])
(string-append (number->string i) ". " chapter)))
]
@section{@racket[for/and] and @racket[for/or]}
The @racket[for/and] form combines iteration results with

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

@ -86,6 +86,19 @@ expression is a list of the results in order.
(error "doesn't get here"))
]}
@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))])]{
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.}
@deftogether[(
@defform[(for/hash (for-clause ...) body ...+)]
@defform[(for/hasheq (for-clause ...) body ...+)]

16
collects/scribblings/reference/numbers.scrbl
View File

@ -1092,6 +1092,22 @@ Sets the inexact real number in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(flvector-length vec)].}
@defproc[(in-flvector (v flvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
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))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{flvector}s.}
@section{Fixnum Operations}

34
collects/tests/racket/flonum.rktl Normal file
View File

@ -0,0 +1,34 @@
(load-relative "loadtest.rktl")
(Section 'flonum)
(require scheme/flonum)
(define (flonum-close? fl1 fl2)
(<= (flabs (fl- fl1 fl2))
1e-8))
;; in-flvector tests.
(let ((flv (flvector 1.0 2.0 3.0)))
(let ((flv-seq (in-flvector flv)))
(for ((x (in-flvector flv))
(xseq flv-seq)
(i (in-naturals)))
(test (+ i 1.0) 'in-flvector-fast x)
(test (+ i 1.0) 'in-flvector-sequence xseq))))
;; 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))))
(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)))))
(test flv 'for*/flvector flv1)
(test flv 'for*/flvector-fast flv2))
(report-errs)

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

@ -185,6 +185,16 @@
(open-input-string "1 2 3\n4 5"))])
(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 '#(0 0 0 0 1 2 0 2 4) 'for*/vector (for*/vector ((i (in-range 3))
(j (in-range 3)))
(* 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)))
(* i j)))
(test #hash((a . 1) (b . 2) (c . 3)) 'mk-hash
(for/hash ([v (in-naturals)]
[k '(a b c)])

1
collects/tests/racket/scheme-tests.rktl
View File

@ -9,4 +9,5 @@
(load-in-sandbox "dict.rktl")
(load-in-sandbox "contract-test.rktl")
(load-in-sandbox "fixnum.rktl")
(load-in-sandbox "flonum.rktl")