Title

Homogeneous and Heterogeneous Arrays

Author

Aubrey Jaffer

Status

This SRFI is currently in ``final'' status. To see an explanation of each status that a SRFI can hold, see here. You can access previous messages via the archive of the mailing list.

Abstract

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.

Issues

Rationale

Arrays

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.

Precision

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.

Homogeneous Arrays

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

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.

Argument Order

Homogeneous Array Types

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:floC128binexact128.bit binary flonum complex
A:floC64b inexact64.bit binary flonum complex
A:floC32b inexact32.bit binary flonum complex
A:floC16b inexact16.bit binary flonum complex
A:floR128binexact128.bit binary flonum real
A:floR64b inexact64.bit binary flonum real
A:floR32b inexact32.bit binary flonum real
A:floR16b inexact16.bit binary flonum real
A:floQ128dexact128.bit decimal flonum rational
A:floQ64d exact64.bit decimal flonum rational
A:floQ32d exact32.bit decimal flonum rational
A:fixZ64b exact64.bit binary fixnum
A:fixZ32b exact32.bit binary fixnum
A:fixZ16b exact16.bit binary fixnum
A:fixZ8b exact8.bit binary fixnum
A:fixN64b exact64.bit nonnegative binary fixnum
A:fixN32b exact32.bit nonnegative binary fixnum
A:fixN16b exact16.bit nonnegative binary fixnum
A:fixN8b exact8.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.

Conversions

Prototype Procedures

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.

Shared Arrays

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

Limit Cases

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.

Specification

Function: array? obj

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

Function: equal? obj1 obj2

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

Function: array-rank obj

Returns the number of dimensions of obj. If obj is not an array, 0 is returned.

Function: array-dimensions array

Returns a list of dimensions.

(array-dimensions (make-array '#() 3 5))
   => (3 5)

Function: make-array prototype k1 ...

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.

Function: make-shared-array array mapper k1 ...

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

Function: list->array rank proto list

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

Function: array->list array

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

Function: vector->array vect proto dim1 ...

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

Function: array->vector array

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)

Function: array-in-bounds? array index1 ...

Returns #t if its arguments would be acceptable to array-ref.

Function: array-ref array k1 ...

Returns the (k1, ...) element of array.

Procedure: array-set! array obj k1 ...

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.

Function: a:floc128b z

Function: a:floc128b
Returns an inexact 128.bit flonum complex uniform-array prototype.

Function: a:floc64b z

Function: a:floc64b
Returns an inexact 64.bit flonum complex uniform-array prototype.

Function: a:floc32b z

Function: a:floc32b
Returns an inexact 32.bit flonum complex uniform-array prototype.

Function: a:floc16b z

Function: a:floc16b
Returns an inexact 16.bit flonum complex uniform-array prototype.

Function: a:flor128b z

Function: a:flor128b
Returns an inexact 128.bit flonum real uniform-array prototype.

Function: a:flor64b z

Function: a:flor64b
Returns an inexact 64.bit flonum real uniform-array prototype.

Function: a:flor32b z

Function: a:flor32b
Returns an inexact 32.bit flonum real uniform-array prototype.

Function: a:flor16b z

Function: a:flor16b
Returns an inexact 16.bit flonum real uniform-array prototype.

Function: a:flor128b z

Function: a:flor128b
Returns an exact 128.bit decimal flonum rational uniform-array prototype.

Function: a:flor64b z

Function: a:flor64b
Returns an exact 64.bit decimal flonum rational uniform-array prototype.

Function: a:flor32b z

Function: a:flor32b
Returns an exact 32.bit decimal flonum rational uniform-array prototype.

Function: a:fixz64b n

Function: a:fixz64b
Returns an exact binary fixnum uniform-array prototype with at least 64 bits of precision.

Function: a:fixz32b n

Function: a:fixz32b
Returns an exact binary fixnum uniform-array prototype with at least 32 bits of precision.

Function: a:fixz16b n

Function: a:fixz16b
Returns an exact binary fixnum uniform-array prototype with at least 16 bits of precision.

Function: a:fixz8b n

Function: a:fixz8b
Returns an exact binary fixnum uniform-array prototype with at least 8 bits of precision.

Function: a:fixn64b k

Function: a:fixn64b
Returns an exact non-negative binary fixnum uniform-array prototype with at least 64 bits of precision.

Function: a:fixn32b k

Function: a:fixn32b
Returns an exact non-negative binary fixnum uniform-array prototype with at least 32 bits of precision.

Function: a:fixn16b k

Function: a:fixn16b
Returns an exact non-negative binary fixnum uniform-array prototype with at least 16 bits of precision.

Function: a:fixn8b k

Function: a:fixn8b
Returns an exact non-negative binary fixnum uniform-array prototype with at least 8 bits of precision.

Function: a:bool bool

Function: a:bool
Returns a boolean uniform-array prototype.

Implementation

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:floR128b (make-prototype-checker 'A:floR128b real? vector))
;;@args z
;;@args
;;Returns an exact 64.bit decimal flonum rational uniform-array prototype.
(define A:floR64b (make-prototype-checker 'A:floR64b real? vector))
;;@args z
;;@args
;;Returns an exact 32.bit decimal flonum rational uniform-array prototype.
(define A:floR32b (make-prototype-checker 'A:floR32b real? 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

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.


Editor: David Van Horn
Last modified: Thu Jan 27 09:30:33 EST 2005