63: Homogeneous and Heterogeneous Arrays63: Homogeneous and Heterogeneous Arraysby Aubrey Jaffer
This SRFI is currently in final status. Here is an explanation of each status that a SRFI can hold. To provide input on this SRFI, please send email to srfi-63@nospamsrfi.schemers.org. To subscribe to the list, follow these instructions. You can access previous messages via the mailing list archive.
A:floQ128d.)The SRFI, which is to supersede SRFI-47, "Array",
Multi-dimensional arrays subsume homogeneous vectors as the one-dimensional case, obviating the need for SRFI-4.
SRFI-58 gives a read/write invariant syntax for the homogeneous and heterogeneous arrays described here.
The conversion rules for exact decimal flonums have yet to be determined. Wisdom in this area would come from experience. Lacking that, it is better to underspecify the behavior of decimal flonums than to make it wrong.
Computations have been organized into multidimensional arrays for over 200 years. Applications for multi-dimensional arrays continue to arise. Computer graphics and imaging, whether vector or raster based, use arrays. A general-purpose computer language without multidimensional arrays is an oxymoron.
R5RS provides an input syntax for inexact numbers which is capable of distinguishing between short, single, double, and long precisions. But R5RS provides no method for limiting the precision of calculations:
In particular, implementations that use flonum representations must follow these rules: A flonum result must be represented with at least as much precision as is used to express any of the inexact arguments to that operation.
And calculation with any exact number inputs blows the precision out to "the most precise flonum format available":
If, however, an exact number is operated upon so as to produce an inexact result (as by `sqrt'), and if the result is represented as a flonum, then the most precise flonum format available must be used; but if the result is represented in some other way then the representation must have at least as much precision as the most precise flonum format available.
Scheme is not much hampered by lack of low-precision inexact numbers for scalar calculations. The extra computation incurred by gratuitous precision is usually small compared with the overhead of type-dispatch and boxed data manipulation.
But if calculations are vectorized, that overhead can become significant. Sophisticated program analysis may be able to deduce that aggregated number storage can be made uniformly of the most precise flonum format available. But even the most aggressive analysis of uncontrived programs will not be able to reduce the precision while yielding results equivalent to the most precise calculation, as R5RS requires.
Also significant is that the numerical data in most Scheme implementations has manifest type information encoded with it. Varying sizes of number objects means that the vectors hold pointers to some numbers, requiring data fetches from memory locations unlikely to be in the same CPU cache-line.
Arrays composed of elements all having the same size representations can eliminate these indirect accesses and the storage allocation associated with them. Homogeneous arrays of lower precision flonums can reduce by factors of 2 or 4 the storage they occupy; which can also speed execution because of the lower bandwidth to the memory necessary to supply the CPU data cache.
Common-Lisp arrays are serviceable, and are the basis for arrays here.
Common-Lisp's make-array does not translate well to
Scheme because the array element type and the initial contents are
passed using named arguments.
Prototype arrays specify both the homogeneous array type (or lack of)
and the initial value or lack of it; allowing these purposes to be
satisfied by one argument to make-array or other
procedures which create arrays.
Some have objected that restricting type specification to arrays is a half-measure. In vectorized programs, specifying the precision of scalar calculations will produce negligible performance improvements. But the performance improvements of homogeneous arrays can accrue to both interpreted and compiled Scheme implementations. By avoiding the morass of general type specification, SRFI-63 can be more easily accommodated by more Scheme implementations.
Most of the procedures originate from Alan Bawden's "array.scm".
SRFI-47's array-set! argument order is that of Bawden's
package. SLIB
adopted "array.scm" in 1993. This form of array-set! has
also been part of the
SCM Scheme
implementation since 1993.
The array-set! argument order is different from the
same-named procedure in
SRFI-25.
Type dispatch on the first argument to array-set! could
support both SRFIs simultaneously.
The make-array arguments are different from the
same-named procedure in
SRFI-25.
Type dispatch on the first argument to make-array could
support both SRFIs simultaneously.
The SRFI-47 argument orders are motivated to make easy dealing with the variable arity resulting from variable rank.
(vector->array vect proto bound1 ...)
(make-array proto bound1 ...)
(make-shared-array array mapper bound1 ...)
(array-set! array obj index1 ...)
(array-in-bounds? array index1 ...)
(array-ref array index1 ...)
The list->array is somewhat dissonant:
(list->array rank proto list)
All implementations must support Scheme strings as rank 1 character arrays. This requirement mandates that Scheme strings be valid arguments to array procedures; their stored representations may be different from other character arrays.
Although an implementation is required to define all the prototype functions, it is not required to support all or even any of the homogeneous numeric arrays. It is assumed that no uniform numeric types have larger precision than the Scheme implementation supports as numbers.
| prototype procedure | exactness | element type |
|---|---|---|
vector | any | |
A:floC128b | inexact | 128.bit binary flonum complex |
A:floC64b | inexact | 64.bit binary flonum complex |
A:floC32b | inexact | 32.bit binary flonum complex |
A:floC16b | inexact | 16.bit binary flonum complex |
A:floR128b | inexact | 128.bit binary flonum real |
A:floR64b | inexact | 64.bit binary flonum real |
A:floR32b | inexact | 32.bit binary flonum real |
A:floR16b | inexact | 16.bit binary flonum real |
A:floQ128d | exact | 128.bit decimal flonum rational |
A:floQ64d | exact | 64.bit decimal flonum rational |
A:floQ32d | exact | 32.bit decimal flonum rational |
A:fixZ64b | exact | 64.bit binary fixnum |
A:fixZ32b | exact | 32.bit binary fixnum |
A:fixZ16b | exact | 16.bit binary fixnum |
A:fixZ8b | exact | 8.bit binary fixnum |
A:fixN64b | exact | 64.bit nonnegative binary fixnum |
A:fixN32b | exact | 32.bit nonnegative binary fixnum |
A:fixN16b | exact | 16.bit nonnegative binary fixnum |
A:fixN8b | exact | 8.bit nonnegative binary fixnum |
A:bool | boolean | |
string | char | |
Decimal flonums are used for financial calculations so that fractional errors do not accumulate. They should be exact numbers.
All the elements of arrays of type A:fixN8b, A:fixN16b, A:fixN32b, A:fixN64b, A:fixZ8b, A:fixZ16b, A:fixZ32b, or A:fixZ64b are exact.
All the elements of arrays of type A:floR16b, A:floR32b, A:floR64b, A:floR128b, A:floC16b, A:floC32b, A:floC64b, and A:floC128b are inexact.
The value retrieved from an exact array element will equal (=) the value stored in that element.
Assigning a non-integer to array-type A:fixN8b, A:fixN16b, A:fixN32b, A:fixN64b, A:fixZ8b, A:fixZ16b, A:fixZ32b, or A:fixZ64b is an error.
Assigning a number larger than can be represented in array-type A:fixN8b, A:fixN16b, A:fixN32b, A:fixN64b, A:fixZ8b, A:fixZ16b, A:fixZ32b, or A:fixZ64b is an error.
Assigning a negative number to array-type A:fixN8b, A:fixN16b, A:fixN32b, or A:fixN64b is an error.
Assigning an inexact number to array-type A:fixN8b, A:fixN16b, A:fixN32b, A:fixN64b, A:fixZ8b, A:fixZ16b, A:fixZ32b, or A:fixZ64b is an error.
When assigning an exact number to an inexact array-type, the procedure may report a violation of an implementation restriction.
Assigning a non-real number (eg. real? returns
#f) to an A:floR128b, A:floR64b, A:floR32b, or
A:floR16b array is an error.
When an inexact number is assigned to an array whose type is lower precision, the number will be rounded to that lower precision if possible; otherwise it is an error.
Implementations are required to define all of the prototype procedures. Uniform types of matching format and sizes which the platform supports will be used; the others will be represented as follows:
For inexact flonum complex arrays:
For inexact flonum real arrays:
For exact decimal flonum arrays:
For exact bipolar fixnum arrays:
For exact nonnegative fixnum arrays:
Note that these rules are used to configure an implementation's definitions of the prototype procedures, which should not themselves be type-dispatching.
This arrangement has platforms which support uniform array types employing them, with less capable platforms using vectors; but all working compatibly from the same source code.
To my knowledge, the specification of shared array index mapping by
means of a procedure is original to Alan Bawden in his "array.scm".
Make-shared-array creates any view into an array whose
coordinates can be mapped by exact integer affine functions. The rank
of the arrays need not match. Shared arrays are quite useful. They
can reverse indexes, make subarrays, and facilitate straightforward
implementations of divide-and-conquer algorithms.
In Common-Lisp a displaced array can be created by calls to adjust-array. But displaced arrays are far less flexible than shared arrays, constrained to have the same rank as the original and allowing only index displacements (not reversals, skips, or shuffling).
The bounds for each index in both Alan Bawden's "array.scm" and SRFI-25 can be any consecutive run of integers. All indexes in SRFI-63 are zero-based for compatibility with R5RS.
Empty arrays having no elements can be of any positive rank. Empty
arrays can be returned from make-shared-array.
Following Common-Lisp's lead, zero-rank arrays have a single element.
Except for character arrays, array access time is O(R)+V, where R is the rank of the array and V is the vector access time.
Character array access time is O(R)+S, where R is the rank of the array and S is the string access time.
Returns #t if the obj is an array, and #f if not.
Note: Arrays are not disjoint from other Scheme types.
Vectors and possibly strings also satisfy array?.
A disjoint array predicate can be written:
(define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj))))
Returns #t if obj1 and obj2 have the same rank and dimensions and the
corresponding elements of obj1 and obj2 are equal?.
equal? recursively compares the contents of pairs, vectors, strings, and
arrays, applying eqv? on other objects such as numbers
and symbols. A rule of thumb is that objects are generally equal? if
they print the same. equal? may fail to terminate if its arguments are
circular data structures.
(equal? 'a 'a) => #t
(equal? '(a) '(a)) => #t
(equal? '(a (b) c)
'(a (b) c)) => #t
(equal? "abc" "abc") => #t
(equal? 2 2) => #t
(equal? (make-vector 5 'a)
(make-vector 5 'a)) => #t
(equal? (make-array (A:fixN32b 4) 5 3)
(make-array (A:fixN32b 4) 5 3)) => #t
(equal? (make-array '#(foo) 3 3)
(make-array '#(foo) 3 3)) => #t
(equal? (lambda (x) x)
(lambda (y) y)) => unspecified
Returns the number of dimensions of obj. If obj is not an array, 0 is returned.
Returns a list of dimensions.
(array-dimensions (make-array '#() 3 5)) => (3 5)
Creates and returns an array of type prototype with dimensions k1, ... and filled with elements from prototype. prototype must be an array, vector, or string. The implementation-dependent type of the returned array will be the same as the type of prototype; except if that would be a vector or string with rank not equal to one, in which case some variety of array will be returned.
If the prototype has no elements, then the initial contents of the returned array are unspecified. Otherwise, the returned array will be filled with the element at the origin of prototype.
make-shared-array can be used to create shared subarrays of other
arrays. The mapper is a function that translates coordinates in
the new array into coordinates in the old array. A mapper must be
linear, and its range must stay within the bounds of the old array, but
it can be otherwise arbitrary. A simple example:
(define fred (make-array '#(#f) 8 8))
(define freds-diagonal
(make-shared-array fred (lambda (i) (list i i)) 8))
(array-set! freds-diagonal 'foo 3)
(array-ref fred 3 3)
=> FOO
(define freds-center
(make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j)))
2 2))
(array-ref freds-center 0 0)
=> FOO
list must be a rank-nested list consisting of all the elements, in row-major order, of the array to be created.
list->array returns an array of rank rank and type proto consisting of all the
elements, in row-major order, of list. When rank is 0, list is the lone
array element; not necessarily a list.
(list->array 2 '#() '((1 2) (3 4)))
=> #2A((1 2) (3 4))
(list->array 0 '#() 3)
=> #0A 3
Returns a rank-nested list consisting of all the elements, in
row-major order, of array. In the case of a rank-0 array, array->list returns
the single element.
(array->list #2A((ho ho ho) (ho oh oh)))
=> ((ho ho ho) (ho oh oh))
(array->list #0A ho)
=> ho
vect must be a vector of length equal to the product of exact nonnegative integers dim1, ....
vector->array returns an array of type proto consisting of all the elements, in
row-major order, of vect. In the case of a rank-0 array, vect has a
single element.
(vector->array #(1 2 3 4) #() 2 2)
=> #2A((1 2) (3 4))
(vector->array '#(3) '#())
=> #0A 3
Returns a new vector consisting of all the elements of array in row-major order.
(array->vector #2A ((1 2)( 3 4)))
=> #(1 2 3 4)
(array->vector #0A ho)
=> #(ho)
Returns #t if its arguments would be acceptable to
array-ref.
Returns the (k1, ...) element of array.
Stores obj in the (k1, ...) element of array. The value returned
by array-set! is unspecified.
These functions return a prototypical uniform-array enclosing the optional argument (which must be of the correct type). If the uniform-array type is supported by the implementation, then it is returned; defaulting to the next larger precision type; resorting finally to vector.
Returns an inexact 128.bit flonum complex uniform-array prototype.
Returns an inexact 64.bit flonum complex uniform-array prototype.
Returns an inexact 16.bit flonum complex uniform-array prototype.
Returns an inexact 128.bit flonum real uniform-array prototype.
Returns an inexact 32.bit flonum real uniform-array prototype.
Returns an inexact 16.bit flonum real uniform-array prototype.
Returns an exact 128.bit decimal flonum rational uniform-array prototype.
Returns an exact 64.bit decimal flonum rational uniform-array prototype.
Returns an exact 32.bit decimal flonum rational uniform-array prototype.
Returns an exact binary fixnum uniform-array prototype with at least 64 bits of precision.
Returns an exact binary fixnum uniform-array prototype with at least 32 bits of precision.
Returns an exact binary fixnum uniform-array prototype with at least 16 bits of precision.
Returns an exact binary fixnum uniform-array prototype with at least 8 bits of precision.
Returns an exact non-negative binary fixnum uniform-array prototype with at least 64 bits of precision.
Returns an exact non-negative binary fixnum uniform-array prototype with at least 32 bits of precision.
Returns an exact non-negative binary fixnum uniform-array prototype with at least 16 bits of precision.
Returns an exact non-negative binary fixnum uniform-array prototype with at least 8 bits of precision.
Returns a boolean uniform-array prototype.
slib/array.scm
implements array procedures for R4RS or R5RS compliant Scheme
implementations with records as implemented by
slib/record.scm
or SRFI-9.
"array.scm" redefines equal? to handle
arrays.
;;;;"array.scm" Arrays for Scheme
; Copyright (C) 2001, 2003 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
;;@code{(require 'array)} or @code{(require 'srfi-63)}
;;@ftindex array
(require 'record)
(define array:rtd
(make-record-type "array"
'(dimensions
scales ;list of dimension scales
offset ;exact integer
store ;data
)))
(define array:dimensions
(let ((dimensions (record-accessor array:rtd 'dimensions)))
(lambda (array)
(cond ((vector? array) (list (vector-length array)))
((string? array) (list (string-length array)))
(else (dimensions array))))))
(define array:scales
(let ((scales (record-accessor array:rtd 'scales)))
(lambda (obj)
(cond ((string? obj) '(1))
((vector? obj) '(1))
(else (scales obj))))))
(define array:store
(let ((store (record-accessor array:rtd 'store)))
(lambda (obj)
(cond ((string? obj) obj)
((vector? obj) obj)
(else (store obj))))))
(define array:offset
(let ((offset (record-accessor array:rtd 'offset)))
(lambda (obj)
(cond ((string? obj) 0)
((vector? obj) 0)
(else (offset obj))))))
(define array:construct
(record-constructor array:rtd '(dimensions scales offset store)))
;;@args obj
;;Returns @code{#t} if the @1 is an array, and @code{#f} if not.
(define array?
(let ((array:array? (record-predicate array:rtd)))
(lambda (obj) (or (string? obj) (vector? obj) (array:array? obj)))))
;;@noindent
;;@emph{Note:} Arrays are not disjoint from other Scheme types.
;;Vectors and possibly strings also satisfy @code{array?}.
;;A disjoint array predicate can be written:
;;
;;@example
;;(define (strict-array? obj)
;; (and (array? obj) (not (string? obj)) (not (vector? obj))))
;;@end example
;;@body
;;Returns @code{#t} if @1 and @2 have the same rank and dimensions and the
;;corresponding elements of @1 and @2 are @code{equal?}.
;;@body
;;@0 recursively compares the contents of pairs, vectors, strings, and
;;@emph{arrays}, applying @code{eqv?} on other objects such as numbers
;;and symbols. A rule of thumb is that objects are generally @0 if
;;they print the same. @0 may fail to terminate if its arguments are
;;circular data structures.
;;
;;@example
;;(equal? 'a 'a) @result{} #t
;;(equal? '(a) '(a)) @result{} #t
;;(equal? '(a (b) c)
;; '(a (b) c)) @result{} #t
;;(equal? "abc" "abc") @result{} #t
;;(equal? 2 2) @result{} #t
;;(equal? (make-vector 5 'a)
;; (make-vector 5 'a)) @result{} #t
;;(equal? (make-array (A:fixN32b 4) 5 3)
;; (make-array (A:fixN32b 4) 5 3)) @result{} #t
;;(equal? (make-array '#(foo) 3 3)
;; (make-array '#(foo) 3 3)) @result{} #t
;;(equal? (lambda (x) x)
;; (lambda (y) y)) @result{} @emph{unspecified}
;;@end example
(define (equal? obj1 obj2)
(cond ((eqv? obj1 obj2) #t)
((or (pair? obj1) (pair? obj2))
(and (pair? obj1) (pair? obj2)
(equal? (car obj1) (car obj2))
(equal? (cdr obj1) (cdr obj2))))
((or (string? obj1) (string? obj2))
(and (string? obj1) (string? obj2)
(string=? obj1 obj2)))
((or (vector? obj1) (vector? obj2))
(and (vector? obj1) (vector? obj2)
(equal? (vector-length obj1) (vector-length obj2))
(do ((idx (+ -1 (vector-length obj1)) (+ -1 idx)))
((or (negative? idx)
(not (equal? (vector-ref obj1 idx)
(vector-ref obj2 idx))))
(negative? idx)))))
((or (array? obj1) (array? obj2))
(and (array? obj1) (array? obj2)
(equal? (array:dimensions obj1) (array:dimensions obj2))
(equal? (array:store obj1) (array:store obj2))))
(else #f)))
;;@body
;;Returns the number of dimensions of @1. If @1 is not an array, 0 is
;;returned.
(define (array-rank obj)
(if (array? obj) (length (array:dimensions obj)) 0))
;;@args array
;;Returns a list of dimensions.
;;
;;@example
;;(array-dimensions (make-array '#() 3 5))
;; @result{} (3 5)
;;@end example
(define array-dimensions array:dimensions)
;;@args prototype k1 @dots{}
;;
;;Creates and returns an array of type @1 with dimensions @2, @dots{}
;;and filled with elements from @1. @1 must be an array, vector, or
;;string. The implementation-dependent type of the returned array
;;will be the same as the type of @1; except if that would be a vector
;;or string with rank not equal to one, in which case some variety of
;;array will be returned.
;;
;;If the @1 has no elements, then the initial contents of the returned
;;array are unspecified. Otherwise, the returned array will be filled
;;with the element at the origin of @1.
(define (make-array prototype . dimensions)
(define tcnt (apply * dimensions))
(let ((store
(if (string? prototype)
(case (string-length prototype)
((0) (make-string tcnt))
(else (make-string tcnt
(string-ref prototype 0))))
(let ((pdims (array:dimensions prototype)))
(case (apply * pdims)
((0) (make-vector tcnt))
(else (make-vector tcnt
(apply array-ref prototype
(map (lambda (x) 0) pdims)))))))))
(define (loop dims scales)
(if (null? dims)
(array:construct dimensions (cdr scales) 0 store)
(loop (cdr dims) (cons (* (car dims) (car scales)) scales))))
(loop (reverse dimensions) '(1))))
;;@args prototype k1 @dots{}
;;@0 is an alias for @code{make-array}.
(define create-array make-array)
;;@args array mapper k1 @dots{}
;;@0 can be used to create shared subarrays of other
;;arrays. The @var{mapper} is a function that translates coordinates in
;;the new array into coordinates in the old array. A @var{mapper} must be
;;linear, and its range must stay within the bounds of the old array, but
;;it can be otherwise arbitrary. A simple example:
;;
;;@example
;;(define fred (make-array '#(#f) 8 8))
;;(define freds-diagonal
;; (make-shared-array fred (lambda (i) (list i i)) 8))
;;(array-set! freds-diagonal 'foo 3)
;;(array-ref fred 3 3)
;; @result{} FOO
;;(define freds-center
;; (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j)))
;; 2 2))
;;(array-ref freds-center 0 0)
;; @result{} FOO
;;@end example
(define (make-shared-array array mapper . dimensions)
(define odl (array:scales array))
(define rank (length dimensions))
(define shape
(map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dimensions))
(do ((idx (+ -1 rank) (+ -1 idx))
(uvt (append (cdr (vector->list (make-vector rank 0))) '(1))
(append (cdr uvt) '(0)))
(uvts '() (cons uvt uvts)))
((negative? idx)
(let ((ker0 (apply + (map * odl (apply mapper uvt)))))
(array:construct
(map (lambda (dim) (+ 1 (- (cadr dim) (car dim)))) shape)
(map (lambda (uvt) (- (apply + (map * odl (apply mapper uvt))) ker0))
uvts)
(apply +
(array:offset array)
(map * odl (apply mapper (map car shape))))
(array:store array))))))
;;@args rank proto list
;;@3 must be a rank-nested list consisting of all the elements, in
;;row-major order, of the array to be created.
;;
;;@0 returns an array of rank @1 and type @2 consisting of all the
;;elements, in row-major order, of @3. When @1 is 0, @3 is the lone
;;array element; not necessarily a list.
;;
;;@example
;;(list->array 2 '#() '((1 2) (3 4)))
;; @result{} #2A((1 2) (3 4))
;;(list->array 0 '#() 3)
;; @result{} #0A 3
;;@end example
(define (list->array rank proto lst)
(define dimensions
(do ((shp '() (cons (length row) shp))
(row lst (car lst))
(rnk (+ -1 rank) (+ -1 rnk)))
((negative? rnk) (reverse shp))))
(let ((nra (apply make-array proto dimensions)))
(define (l2ra dims idxs row)
(cond ((null? dims)
(apply array-set! nra row (reverse idxs)))
((if (not (eqv? (car dims) (length row)))
(slib:error 'list->array
'non-rectangular 'array dims dimensions))
(do ((idx 0 (+ 1 idx))
(row row (cdr row)))
((>= idx (car dims)))
(l2ra (cdr dims) (cons idx idxs) (car row))))))
(l2ra dimensions '() lst)
nra))
;;@args array
;;Returns a rank-nested list consisting of all the elements, in
;;row-major order, of @1. In the case of a rank-0 array, @0 returns
;;the single element.
;;
;;@example
;;(array->list #2A((ho ho ho) (ho oh oh)))
;; @result{} ((ho ho ho) (ho oh oh))
;;(array->list #0A ho)
;; @result{} ho
;;@end example
(define (array->list ra)
(define (ra2l dims idxs)
(if (null? dims)
(apply array-ref ra (reverse idxs))
(do ((lst '() (cons (ra2l (cdr dims) (cons idx idxs)) lst))
(idx (+ -1 (car dims)) (+ -1 idx)))
((negative? idx) lst))))
(ra2l (array-dimensions ra) '()))
;;@args vect proto dim1 @dots{}
;;@1 must be a vector of length equal to the product of exact
;;nonnegative integers @3, @dots{}.
;;
;;@0 returns an array of type @2 consisting of all the elements, in
;;row-major order, of @1. In the case of a rank-0 array, @1 has a
;;single element.
;;
;;@example
;;(vector->array #(1 2 3 4) #() 2 2)
;; @result{} #2A((1 2) (3 4))
;;(vector->array '#(3) '#())
;; @result{} #0A 3
;;@end example
(define (vector->array vect prototype . dimensions)
(define vdx (vector-length vect))
(if (not (eqv? vdx (apply * dimensions)))
(slib:error 'vector->array vdx '<> (cons '* dimensions)))
(let ((ra (apply make-array prototype dimensions)))
(define (v2ra dims idxs)
(cond ((null? dims)
(set! vdx (+ -1 vdx))
(apply array-set! ra (vector-ref vect vdx) (reverse idxs)))
(else
(do ((idx (+ -1 (car dims)) (+ -1 idx)))
((negative? idx) vect)
(v2ra (cdr dims) (cons idx idxs))))))
(v2ra dimensions '())
ra))
;;@args array
;;Returns a new vector consisting of all the elements of @1 in
;;row-major order.
;;
;;@example
;;(array->vector #2A ((1 2)( 3 4)))
;; @result{} #(1 2 3 4)
;;(array->vector #0A ho)
;; @result{} #(ho)
;;@end example
(define (array->vector ra)
(define dims (array-dimensions ra))
(let* ((vdx (apply * dims))
(vect (make-vector vdx)))
(define (ra2v dims idxs)
(if (null? dims)
(let ((val (apply array-ref ra (reverse idxs))))
(set! vdx (+ -1 vdx))
(vector-set! vect vdx val)
vect)
(do ((idx (+ -1 (car dims)) (+ -1 idx)))
((negative? idx) vect)
(ra2v (cdr dims) (cons idx idxs)))))
(ra2v dims '())))
(define (array:in-bounds? array indices)
(do ((bnds (array:dimensions array) (cdr bnds))
(idxs indices (cdr idxs)))
((or (null? bnds)
(null? idxs)
(not (integer? (car idxs)))
(not (< -1 (car idxs) (car bnds))))
(and (null? bnds) (null? idxs)))))
;;@args array index1 @dots{}
;;Returns @code{#t} if its arguments would be acceptable to
;;@code{array-ref}.
(define (array-in-bounds? array . indices)
(array:in-bounds? array indices))
;;@args array k1 @dots{}
;;Returns the (@2, @dots{}) element of @1.
(define (array-ref array . indices)
(define store (array:store array))
(or (array:in-bounds? array indices)
(slib:error 'array-ref 'bad-indices indices))
((if (string? store) string-ref vector-ref)
store (apply + (array:offset array) (map * (array:scales array) indices))))
;;@args array obj k1 @dots{}
;;Stores @2 in the (@3, @dots{}) element of @1. The value returned
;;by @0 is unspecified.
(define (array-set! array obj . indices)
(define store (array:store array))
(or (array:in-bounds? array indices)
(slib:error 'array-set! 'bad-indices indices))
((if (string? store) string-set! vector-set!)
store (apply + (array:offset array) (map * (array:scales array) indices))
obj))
;;@noindent
;;These functions return a prototypical uniform-array enclosing the
;;optional argument (which must be of the correct type). If the
;;uniform-array type is supported by the implementation, then it is
;;returned; defaulting to the next larger precision type; resorting
;;finally to vector.
(define (make-prototype-checker name pred? creator)
(lambda args
(case (length args)
((1) (if (pred? (car args))
(creator (car args))
(slib:error name 'incompatible 'type (car args))))
((0) (creator))
(else (slib:error name 'wrong 'number 'of 'args args)))))
(define (integer-bytes?? n)
(lambda (obj)
(and (integer? obj)
(exact? obj)
(or (negative? n) (not (negative? obj)))
(do ((num obj (quotient num 256))
(n (+ -1 (abs n)) (+ -1 n)))
((or (zero? num) (negative? n))
(zero? num))))))
;;@args z
;;@args
;;Returns an inexact 128.bit flonum complex uniform-array prototype.
(define A:floC128b (make-prototype-checker 'A:floC128b complex? vector))
;;@args z
;;@args
;;Returns an inexact 64.bit flonum complex uniform-array prototype.
(define A:floC64b (make-prototype-checker 'A:floC64b complex? vector))
;;@args z
;;@args
;;Returns an inexact 32.bit flonum complex uniform-array prototype.
(define A:floC32b (make-prototype-checker 'A:floC32b complex? vector))
;;@args z
;;@args
;;Returns an inexact 16.bit flonum complex uniform-array prototype.
(define A:floC16b (make-prototype-checker 'A:floC16b complex? vector))
;;@args z
;;@args
;;Returns an inexact 128.bit flonum real uniform-array prototype.
(define A:floR128b (make-prototype-checker 'A:floR128b real? vector))
;;@args z
;;@args
;;Returns an inexact 64.bit flonum real uniform-array prototype.
(define A:floR64b (make-prototype-checker 'A:floR64b real? vector))
;;@args z
;;@args
;;Returns an inexact 32.bit flonum real uniform-array prototype.
(define A:floR32b (make-prototype-checker 'A:floR32b real? vector))
;;@args z
;;@args
;;Returns an inexact 16.bit flonum real uniform-array prototype.
(define A:floR16b (make-prototype-checker 'A:floR16b real? vector))
;;@args z
;;@args
;;Returns an exact 128.bit decimal flonum rational uniform-array prototype.
(define A:floQ128d (make-prototype-checker 'A:floQ128d rational? vector))
;;@args z
;;@args
;;Returns an exact 64.bit decimal flonum rational uniform-array prototype.
(define A:floQ64d (make-prototype-checker 'A:floQ64d rational? vector))
;;@args z
;;@args
;;Returns an exact 32.bit decimal flonum rational uniform-array prototype.
(define A:floQ32d (make-prototype-checker 'A:floQ32d rational? vector))
;;@args n
;;@args
;;Returns an exact binary fixnum uniform-array prototype with at least
;;64 bits of precision.
(define A:fixZ64b (make-prototype-checker 'A:fixZ64b (integer-bytes?? -8) vector))
;;@args n
;;@args
;;Returns an exact binary fixnum uniform-array prototype with at least
;;32 bits of precision.
(define A:fixZ32b (make-prototype-checker 'A:fixZ32b (integer-bytes?? -4) vector))
;;@args n
;;@args
;;Returns an exact binary fixnum uniform-array prototype with at least
;;16 bits of precision.
(define A:fixZ16b (make-prototype-checker 'A:fixZ16b (integer-bytes?? -2) vector))
;;@args n
;;@args
;;Returns an exact binary fixnum uniform-array prototype with at least
;;8 bits of precision.
(define A:fixZ8b (make-prototype-checker 'A:fixZ8b (integer-bytes?? -1) vector))
;;@args k
;;@args
;;Returns an exact non-negative binary fixnum uniform-array prototype with at
;;least 64 bits of precision.
(define A:fixN64b (make-prototype-checker 'A:fixN64b (integer-bytes?? 8) vector))
;;@args k
;;@args
;;Returns an exact non-negative binary fixnum uniform-array prototype with at
;;least 32 bits of precision.
(define A:fixN32b (make-prototype-checker 'A:fixN32b (integer-bytes?? 4) vector))
;;@args k
;;@args
;;Returns an exact non-negative binary fixnum uniform-array prototype with at
;;least 16 bits of precision.
(define A:fixN16b (make-prototype-checker 'A:fixN16b (integer-bytes?? 2) vector))
;;@args k
;;@args
;;Returns an exact non-negative binary fixnum uniform-array prototype with at
;;least 8 bits of precision.
(define A:fixN8b (make-prototype-checker 'A:fixN8b (integer-bytes?? 1) vector))
;;@args bool
;;@args
;;Returns a boolean uniform-array prototype.
(define A:bool (make-prototype-checker 'A:bool boolean? vector))
Copyright (C) 2005 Aubrey Jaffer
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.