From 8a52f8ace51bbaa7d74062de3d594a46b91d3ed0 Mon Sep 17 00:00:00 2001
From: Tobias Hammer <tobias.hammer@dlr.de>
Date: Fri, 19 Jul 2013 15:35:10 +0200
Subject: [PATCH] Add ffi array-type and in-array

---
 .../scribblings/foreign/types.scrbl           | 15 ++++++++++++
 .../tests/racket/foreign-test.rktl            | 17 ++++++++++++++
 racket/collects/ffi/unsafe.rkt                | 23 ++++++++++++++++---
 racket/collects/racket/HISTORY.txt            |  1 +
 4 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl
index 0ca1794c79..bd8d1c7b8c 100644
--- a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl
@@ -1289,6 +1289,21 @@ Extracts the length of an array. For a multidimensional array, the
 result is still a single number; extract an element to get
 a sub-array to get the length of the next dimension, and so on.}
 
+@defproc[(array-type [a array?]) ctype?]{
+
+Extracts the type of the array. For a multidimensional array, the
+result is the ctype of the nested array.}
+
+@defproc[(in-array [a array?]
+                  [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[a] when no optional
+  arguments are supplied.
+
+  The optional arguments @racket[start], @racket[stop], and
+  @racket[step] are as in @racket[in-vector].}
 
 @defproc[(_array/list [type ctype?] [count exact-nonnegative-integer?] ...+)
          ctype?]{
diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl
index ea708c07e7..7885fc59ec 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl
@@ -527,6 +527,23 @@
   (check (lambda (f) (f)) add1)
   (check (box 20) (lambda (x) 20)))
 
+;; check in-array
+(let ()
+  (define _t (_array _int 6))
+  (define ar (ptr-ref (malloc _t) _t))
+  (for ([i (array-length ar)])
+    (array-set! ar i (+ 10 i)))
+
+  (test '(10 11 12 13 14 15) values (for/list ([a (in-array ar)]) a))
+  (test '(11 12 13 14 15) values (for/list ([a (in-array ar 1)]) a))
+  (test '(11 12) values (for/list ([a (in-array ar 1 3)]) a))
+  (test '(10 12 14) values (for/list ([a (in-array ar 0 #f 2)]) a))
+
+  (define seq (in-array ar))
+  (test '(10 11 12 13 14 15) values (for/list ([a seq]) a))
+
+  (err/rt-test (in-array '(1 2 3)) exn:fail:contract?))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt
index c5d30e1720..52f3ef1793 100644
--- a/racket/collects/ffi/unsafe.rkt
+++ b/racket/collects/ffi/unsafe.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 
 ;; Foreign Racket interface
-(require '#%foreign setup/dirs racket/unsafe/ops
+(require '#%foreign setup/dirs racket/unsafe/ops racket/private/for
          (for-syntax racket/base racket/list syntax/stx
                      racket/struct-info))
 
@@ -998,8 +998,9 @@
 
 ;; (_array <type> <len> ...+)
 (provide _array
-         array? array-length array-ptr
-         (protect-out array-ref array-set!))
+         array? array-length array-ptr array-type
+         (protect-out array-ref array-set!)
+         (rename-out [*in-array in-array]))
 
 (define _array
   (case-lambda
@@ -1039,6 +1040,22 @@
             (array-set! a i v)
             (loop (array-ref a (car is)) (cdr is)))))]))
 
+;; (in-aray array [start stop step])
+;; in-vector like sequence over array
+(define-:vector-like-gen :array-gen array-ref)
+
+(define-in-vector-like in-array
+  "array" array? array-length :array-gen)
+
+(define-sequence-syntax *in-array
+  (lambda () #'in-array)
+  (make-in-vector-like 'in-array
+                       "array"
+                       #'array?
+                       #'array-length
+                       #'in-array
+                       #'array-ref))
+
 ;; (_array/list <type> <len> ...+)
 ;; Like _list, but for arrays instead of pointers at the C level.
 (provide _array/list)
diff --git a/racket/collects/racket/HISTORY.txt b/racket/collects/racket/HISTORY.txt
index 647babb12b..7c1b9421a2 100644
--- a/racket/collects/racket/HISTORY.txt
+++ b/racket/collects/racket/HISTORY.txt
@@ -2,6 +2,7 @@ Version 5.90.0.1
 Added "share" directory, moved "pkgs" there; moved "collects"
  back out of "lib"
 setup/dirs: added find-share-dir, find-user-share-dir
+ffi/unsafe: added array-type and in-array
 
 Version 5.3.900.7
 Changed equal? to work on module path index values