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

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

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

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

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

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}
 

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)

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

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