From 82096abb1b6fd4a8872f528437ba95c44a4aedba Mon Sep 17 00:00:00 2001 From: "Will M. Farr" Date: Thu, 19 Aug 2010 10:23:52 -0500 Subject: [PATCH] Added interation forms for/vector, for*/vector, for/flvector, and for*/flvector and for-clause in-flvector. --- collects/racket/flonum.rkt | 65 +++++++++++++++++++- collects/racket/private/for.rkt | 26 ++++++++ collects/scribblings/guide/for.scrbl | 27 ++++++++ collects/scribblings/reference/for.scrbl | 13 ++++ collects/scribblings/reference/numbers.scrbl | 16 +++++ collects/tests/racket/flonum.rktl | 34 ++++++++++ collects/tests/racket/for.rktl | 10 +++ collects/tests/racket/scheme-tests.rktl | 1 + 8 files changed, 190 insertions(+), 2 deletions(-) create mode 100644 collects/tests/racket/flonum.rktl diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index c2c0667902..d7d4e23a83 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -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)))))) \ No newline at end of file diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 6b63210598..5cd17719bd 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -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 ...) diff --git a/collects/scribblings/guide/for.scrbl b/collects/scribblings/guide/for.scrbl index 594faff861..85446486e5 100644 --- a/collects/scribblings/guide/for.scrbl +++ b/collects/scribblings/guide/for.scrbl @@ -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 diff --git a/collects/scribblings/reference/for.scrbl b/collects/scribblings/reference/for.scrbl index 5103681b77..c5a8abf076 100644 --- a/collects/scribblings/reference/for.scrbl +++ b/collects/scribblings/reference/for.scrbl @@ -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 ...+)] diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index 6ea439b46a..6509be73f3 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -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} diff --git a/collects/tests/racket/flonum.rktl b/collects/tests/racket/flonum.rktl new file mode 100644 index 0000000000..5b96f17563 --- /dev/null +++ b/collects/tests/racket/flonum.rktl @@ -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) \ No newline at end of file diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index de8f332360..2780ce238f 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -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)]) diff --git a/collects/tests/racket/scheme-tests.rktl b/collects/tests/racket/scheme-tests.rktl index 1f5b7c4f62..8b7aef79de 100644 --- a/collects/tests/racket/scheme-tests.rktl +++ b/collects/tests/racket/scheme-tests.rktl @@ -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")