ffi/unsafe: add `array-length'

Closes PR 12576
This commit is contained in:
Matthew Flatt 2012-02-20 08:07:33 -07:00
parent 6371df556c
commit a884c91720
3 changed files with 12 additions and 4 deletions

View File

@ -973,7 +973,7 @@
;; (_array <type> <len> ...+) ;; (_array <type> <len> ...+)
(provide _array (provide _array
array? array-ptr array? array-length array-ptr
(protect-out array-ref array-set!)) (protect-out array-ref array-set!))
(define _array (define _array
@ -985,11 +985,11 @@
[(t n . ns) [(t n . ns)
(_array (apply _array t ns) n)])) (_array (apply _array t ns) n)]))
(define-struct array (ptr type len)) (define-struct array (ptr type length))
(define array-ref (define array-ref
(case-lambda (case-lambda
[(a i) [(a i)
(let ([len (array-len a)]) (let ([len (array-length a)])
(if (< -1 i len) (if (< -1 i len)
(ptr-ref (array-ptr a) (array-type a) i) (ptr-ref (array-ptr a) (array-type a) i)
(raise-mismatch-error 'array-ref "index out of bounds: " i)))] (raise-mismatch-error 'array-ref "index out of bounds: " i)))]
@ -1001,7 +1001,7 @@
(define array-set! (define array-set!
(case-lambda (case-lambda
[(a i v) [(a i v)
(let ([len (array-len a)]) (let ([len (array-length a)])
(if (< -1 i len) (if (< -1 i len)
(ptr-set! (array-ptr a) (array-type a) i v) (ptr-set! (array-ptr a) (array-type a) i v)
(raise-mismatch-error 'array-ref "index out of bounds: " i)))] (raise-mismatch-error 'array-ref "index out of bounds: " i)))]

View File

@ -1137,6 +1137,13 @@ sub-array).}
Extracts the pointer for an array's storage.} Extracts the pointer for an array's storage.}
@defproc[(array-length [a array?]) exact-nonnegative-integer?]{
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/list [type ctype?] [count exact-nonnegative-integer?] ...+) @defproc[(_array/list [type ctype?] [count exact-nonnegative-integer?] ...+)
ctype?]{ ctype?]{

View File

@ -223,6 +223,7 @@
(test (for/list ([i 7]) (+ i 10)) cast p _pointer (_list o _byte 7)) (test (for/list ([i 7]) (+ i 10)) cast p _pointer (_list o _byte 7))
(t (for/list ([i 7]) (+ i 11)) 'increment_c_array (_fun _pointer -> (_list o _byte 7)) p) (t (for/list ([i 7]) (+ i 11)) 'increment_c_array (_fun _pointer -> (_list o _byte 7)) p)
(let ([a (ptr-ref p (_array _byte 7))]) (let ([a (ptr-ref p (_array _byte 7))])
(test 7 array-length a)
(test 12 array-ref a 1) (test 12 array-ref a 1)
(ptr-set! p _byte 1 17) (ptr-set! p _byte 1 17)
(test 17 array-ref a 1))) (test 17 array-ref a 1)))