summaryrefslogtreecommitdiffstats
path: root/array.scm
diff options
context:
space:
mode:
Diffstat (limited to 'array.scm')
-rw-r--r--array.scm528
1 files changed, 334 insertions, 194 deletions
diff --git a/array.scm b/array.scm
index 417e137..5f87b98 100644
--- a/array.scm
+++ b/array.scm
@@ -1,5 +1,5 @@
;;;;"array.scm" Arrays for Scheme
-; Copyright (C) 2001, 2003 Aubrey Jaffer
+; Copyright (C) 2001, 2003, 2005 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
@@ -17,25 +17,25 @@
;promotional, or sales literature without prior written consent in
;each case.
-;;@code{(require 'array)}
+;;@code{(require 'array)} or @code{(require 'srfi-63)}
;;@ftindex array
(require 'record)
(define array:rtd
(make-record-type "array"
- '(shape
+ '(dimensions
scales ;list of dimension scales
offset ;exact integer
store ;data
)))
-(define array:shape
- (let ((shape (record-accessor array:rtd 'shape)))
+(define array:dimensions
+ (let ((dimensions (record-accessor array:rtd 'dimensions)))
(lambda (array)
- (cond ((vector? array) (list (list 0 (+ -1 (vector-length array)))))
- ((string? array) (list (list 0 (+ -1 (string-length array)))))
- (else (shape 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)))
@@ -59,7 +59,7 @@
(else (offset obj))))))
(define array:construct
- (record-constructor array:rtd '(shape scales offset store)))
+ (record-constructor array:rtd '(dimensions scales offset store)))
;;@args obj
;;Returns @code{#t} if the @1 is an array, and @code{#f} if not.
@@ -68,9 +68,9 @@
(lambda (obj) (or (string? obj) (vector? obj) (array:array? obj)))))
;;@noindent
-;;@emph{Note:} Arrays are not disjoint from other Scheme types. Strings
-;;and vectors also satisfy @code{array?}. A disjoint array predicate can
-;;be written:
+;;@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)
@@ -78,159 +78,106 @@
;;@end example
;;@body
-;;Returns @code{#t} if @1 and @2 have the same rank and shape and the
+;;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
-;;(array=? (create-array '#(foo) 3 3)
-;; (create-array '#(foo) '(0 2) '(0 2)))
-;; @result{} #t
+;;(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 (array=? array1 array2)
- (and (equal? (array:shape array1) (array:shape array2))
- (equal? (array:store array1) (array:store array2))))
+(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)))
-(define (array:dimensions->shape dims)
- (map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dims))
+;;@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 bound1 bound2 @dots{}
+;;@args prototype k1 @dots{}
;;
-;;Creates and returns an array of type @1 with dimensions @2, @3,
-;;@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 non-zero origin, in which case some variety of
+;;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 (create-array prototype . dimensions)
- (define range2length (lambda (bnd) (- 1 (apply - bnd))))
- ;;(if (not (array? prototype)) (set! prototype (vector prototype)))
- (let* ((shape (array:dimensions->shape dimensions))
- (dims (map range2length shape))
- (scales
- (do ((dims (reverse (cdr dims)) (cdr dims))
- (scls '(1) (cons (* (car dims) (car scls)) scls)))
- ((null? dims) scls))))
- (array:construct
- shape
- scales
- (- (apply + (map * (map car shape) scales)))
- (if (string? prototype)
- (case (string-length prototype)
- ((0) (make-string (apply * dims)))
- (else (make-string (apply * dims)
- (string-ref prototype 0))))
- (let ((pshape (array:shape prototype)))
- (case (apply * (map range2length pshape))
- ((0) (make-vector (apply * dims)))
- (else (make-vector (apply * dims)
- (apply array-ref prototype
- (map car pshape))))))))))
-
-;;@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 a high-precision complex uniform-array prototype.
-(define Ac64 (make-prototype-checker 'Ac64 complex? vector))
-;;@args z
-;;@args
-;;Returns a complex uniform-array prototype.
-(define Ac32 (make-prototype-checker 'Ac32 complex? vector))
-
-;;@args x
-;;@args
-;;Returns a high-precision real uniform-array prototype.
-(define Ar64 (make-prototype-checker 'Ar64 real? vector))
-;;@args x
-;;@args
-;;Returns a real uniform-array prototype.
-(define Ar32 (make-prototype-checker 'Ar32 real? vector))
-
-;;@args n
-;;@args
-;;Returns an exact signed integer uniform-array prototype with at least
-;;64 bits of precision.
-(define As64 (make-prototype-checker 'As64 (integer-bytes?? -8) vector))
-;;@args n
-;;@args
-;;Returns an exact signed integer uniform-array prototype with at least
-;;32 bits of precision.
-(define As32 (make-prototype-checker 'As32 (integer-bytes?? -4) vector))
-;;@args n
-;;@args
-;;Returns an exact signed integer uniform-array prototype with at least
-;;16 bits of precision.
-(define As16 (make-prototype-checker 'As16 (integer-bytes?? -2) vector))
-;;@args n
-;;@args
-;;Returns an exact signed integer uniform-array prototype with at least
-;;8 bits of precision.
-(define As8 (make-prototype-checker 'As8 (integer-bytes?? -1) vector))
-
-;;@args k
-;;@args
-;;Returns an exact non-negative integer uniform-array prototype with at
-;;least 64 bits of precision.
-(define Au64 (make-prototype-checker 'Au64 (integer-bytes?? 8) vector))
-;;@args k
-;;@args
-;;Returns an exact non-negative integer uniform-array prototype with at
-;;least 32 bits of precision.
-(define Au32 (make-prototype-checker 'Au32 (integer-bytes?? 4) vector))
-;;@args k
-;;@args
-;;Returns an exact non-negative integer uniform-array prototype with at
-;;least 16 bits of precision.
-(define Au16 (make-prototype-checker 'Au16 (integer-bytes?? 2) vector))
-;;@args k
-;;@args
-;;Returns an exact non-negative integer uniform-array prototype with at
-;;least 8 bits of precision.
-(define Au8 (make-prototype-checker 'Au8 (integer-bytes?? 1) vector))
-
-;;@args bool
-;;@args
-;;Returns a boolean uniform-array prototype.
-(define At1 (make-prototype-checker 'At1 boolean? vector))
-
-;;@noindent
-;;When constructing an array, @var{bound} is either an inclusive range of
-;;indices expressed as a two element list, or an upper bound expressed as
-;;a single integer. So
-;;
-;;@example
-;;(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2))
-;;@end example
-
-;;@args array mapper bound1 bound2 @dots{}
+(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
@@ -238,7 +185,7 @@
;;it can be otherwise arbitrary. A simple example:
;;
;;@example
-;;(define fred (create-array '#(#f) 8 8))
+;;(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)
@@ -253,68 +200,149 @@
(define (make-shared-array array mapper . dimensions)
(define odl (array:scales array))
(define rank (length dimensions))
- (define shape (array:dimensions->shape 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))))
- (scales (map (lambda (uvt)
- (- (apply + (map * odl (apply mapper uvt))) ker0))
- uvts)))
+ (let ((ker0 (apply + (map * odl (apply mapper uvt)))))
(array:construct
- shape
- scales
- (- (apply + (array:offset array)
- (map * odl (apply mapper (map car shape))))
- (apply + (map * (map car shape) scales)))
+ (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))))))
-;;@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:shape obj)) 0))
+;;@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 list of inclusive bounds.
+;;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
-;;(array-shape (create-array '#() 3 5))
-;; @result{} ((0 2) (0 4))
+;;(vector->array #(1 2 3 4) #() 2 2)
+;; @result{} #2A((1 2) (3 4))
+;;(vector->array '#(3) '#())
+;; @result{} #0A 3
;;@end example
-(define array-shape array:shape)
+(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))
-;;@body
-;;@code{array-dimensions} is similar to @code{array-shape} but replaces
-;;elements with a 0 minimum with one greater than the maximum.
+;;@args array
+;;Returns a new vector consisting of all the elements of @1 in
+;;row-major order.
;;
;;@example
-;;(array-dimensions (create-array '#() 3 5))
-;; @result{} (3 5)
+;;(array->vector #2A ((1 2)( 3 4)))
+;; @result{} #(1 2 3 4)
+;;(array->vector #0A ho)
+;; @result{} #(ho)
;;@end example
-(define (array-dimensions array)
- (map (lambda (bnd) (if (zero? (car bnd)) (+ 1 (cadr bnd)) bnd))
- (array:shape array)))
+(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:shape array) (cdr bnds))
+ (do ((bnds (array:dimensions array) (cdr bnds))
(idxs indices (cdr idxs)))
((or (null? bnds)
(null? idxs)
(not (integer? (car idxs)))
- (not (<= (caar bnds) (car idxs) (cadar bnds))))
+ (not (< -1 (car idxs) (car bnds))))
(and (null? bnds) (null? idxs)))))
-;;@args array index1 index2 @dots{}
+;;@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 index1 index2 @dots{}
-;;Returns the (@2, @3, @dots{}) element of @1.
+;;@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)
@@ -322,8 +350,8 @@
((if (string? store) string-ref vector-ref)
store (apply + (array:offset array) (map * (array:scales array) indices))))
-;;@args array obj index1 index2 @dots{}
-;;Stores @2 in the (@3, @4, @dots{}) element of @1. The value returned
+;;@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))
@@ -333,10 +361,122 @@
store (apply + (array:offset array) (map * (array:scales array) indices))
obj))
-;;; Legacy functions
+;;@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 initial-value bound1 bound2 @dots{}
-;; ;;Creates and returns an array with dimensions @2,
-;; ;;@3, @dots{} and filled with @1.
-;; (define (make-array initial-value . dimensions)
-;; (apply create-array (vector initial-value) dimensions))
+;;@args bool
+;;@args
+;;Returns a boolean uniform-array prototype.
+(define A:bool (make-prototype-checker 'A:bool boolean? vector))