HomeAboutCodePastes
summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordieggsy <dieggsy@pm.me>2021-03-03 21:19:37 -0500
committerdieggsy <dieggsy@pm.me>2021-03-03 21:45:08 -0500
commitce6e3dab68b0e6f337d0c30e22ee6068791410a5 (patch)
tree493a9c96f41189e1b0fad82c7820f29a3ef62903
parent54a8851d66ad487ac9649951470824a6b4e4514d (diff)
downloadsrfi-179-ce6e3dab68b0e6f337d0c30e22ee6068791410a5.tar.gz
Make error handling slightly more idiomatic0.2.3
-rw-r--r--generic-arrays.scm433
-rw-r--r--srfi-179.egg4
-rw-r--r--srfi-179.release-info1
-rw-r--r--tests/run.scm470
4 files changed, 449 insertions, 459 deletions
diff --git a/generic-arrays.scm b/generic-arrays.scm
index 6039647..eb703e6 100644
--- a/generic-arrays.scm
+++ b/generic-arrays.scm
@@ -148,7 +148,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(fx< 0 (vector-length upper-bounds))
(%%vector-every (lambda (x) (exact-integer? x)) upper-bounds)
(%%vector-every (lambda (x) (positive? x)) upper-bounds)))
- (error "make-interval: The argument is not a nonempty vector of positive exact integers: " upper-bounds))
+ (error 'make-interval "The argument is not a nonempty vector of positive exact integers" upper-bounds))
(else
(let ((dimension (vector-length upper-bounds)))
(%%finish-interval (if (fx< dimension 5)
@@ -159,16 +159,16 @@ OTHER DEALINGS IN THE SOFTWARE.
(cond ((not (and (vector? lower-bounds)
(fx< 0 (vector-length lower-bounds))
(%%vector-every (lambda (x) (exact-integer? x)) lower-bounds)))
- (error "make-interval: The first argument is not a nonempty vector of exact integers: " lower-bounds upper-bounds))
+ (error 'make-interval "The first argument is not a nonempty vector of exact integers" lower-bounds upper-bounds))
((not (and (vector? upper-bounds)
(fx< 0 (vector-length upper-bounds))
(%%vector-every (lambda (x) (exact-integer? x)) upper-bounds)))
- (error "make-interval: The second argument is not a nonempty vector of exact integers: " lower-bounds upper-bounds))
+ (error 'make-interval "The second argument is not a nonempty vector of exact integers" lower-bounds upper-bounds))
((not (fx= (vector-length lower-bounds)
(vector-length upper-bounds)))
- (error "make-interval: The first and second arguments are not the same length: " lower-bounds upper-bounds))
+ (error 'make-interval "The first and second arguments are not the same length" lower-bounds upper-bounds))
((not (%%vector-every (lambda (x y) (< x y)) lower-bounds upper-bounds))
- (error "make-interval: Each lower-bound must be less than the associated upper-bound: " lower-bounds upper-bounds))
+ (error 'make-interval "Each lower-bound must be less than the associated upper-bound" lower-bounds upper-bounds))
(else
(%%finish-interval (vector-copy lower-bounds)
(vector-copy upper-bounds)))))))
@@ -206,63 +206,63 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-dimension interval)
(cond ((not (interval? interval))
- (error "interval-dimension: The argument is not an interval: " interval))
+ (error 'interval-dimension "The argument is not an interval" interval))
(else
(%%interval-dimension interval))))
(define (interval-lower-bound interval i)
(cond ((not (interval? interval))
- (error "interval-lower-bound: The first argument is not an interval: " interval i))
+ (error 'interval-lower-bound "The first argument is not an interval" interval i))
((not (and (fixnum? i)
(fx< -1 i)
(fx< i (%%interval-dimension interval))))
- (error "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): " interval i))
+ (error 'interval-lower-bound "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)" interval i))
(else
(%%interval-lower-bound interval i))))
(define (interval-upper-bound interval i)
(cond ((not (interval? interval))
- (error "interval-upper-bound: The first argument is not an interval: " interval i))
+ (error 'interval-upper-bound "The first argument is not an interval" interval i))
((not (and (fixnum? i)
(fx< -1 i)
(fx< i (%%interval-dimension interval))))
- (error "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): " interval i))
+ (error 'interval-upper-bound "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)" interval i))
(else
(%%interval-upper-bound interval i))))
(define (interval-lower-bounds->vector interval)
(cond ((not (interval? interval))
- (error "interval-lower-bounds->vector: The argument is not an interval: " interval))
+ (error 'interval-lower-bounds->vector "The argument is not an interval" interval))
(else
(%%interval-lower-bounds->vector interval))))
(define (interval-upper-bounds->vector interval)
(cond ((not (interval? interval))
- (error "interval-upper-bounds->vector: The argument is not an interval: " interval))
+ (error 'interval-upper-bounds->vector "The argument is not an interval" interval))
(else
(%%interval-upper-bounds->vector interval))))
(define (interval-lower-bounds->list interval)
(cond ((not (interval? interval))
- (error "interval-lower-bounds->list: The argument is not an interval: " interval))
+ (error 'interval-lower-bounds->list "The argument is not an interval" interval))
(else
(%%interval-lower-bounds->list interval))))
(define (interval-upper-bounds->list interval)
(cond ((not (interval? interval))
- (error "interval-upper-bounds->list: The argument is not an interval: " interval))
+ (error 'interval-upper-bounds->list "The argument is not an interval" interval))
(else
(%%interval-upper-bounds->list interval))))
(define (interval-projections interval right-dimension)
(cond ((not (interval? interval))
- (error "interval-projections: The first argument is not an interval: " interval right-dimension))
+ (error 'interval-projections "The first argument is not an interval" interval right-dimension))
((not (fx< 1 (%%interval-dimension interval))) ;; redundant check, but useful error message
- (error "interval-projections: The dimension of the first argument is not greater than 1: " interval right-dimension))
+ (error 'interval-projections "The dimension of the first argument is not greater than 1" interval right-dimension))
((not (and (fixnum? right-dimension)
(fx< 0 right-dimension)
(fx< right-dimension (%%interval-dimension interval))))
- (error "interval-projections: The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive): " interval right-dimension))
+ (error 'interval-projections "The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive)" interval right-dimension))
(else
(%%interval-projections interval right-dimension))))
@@ -335,11 +335,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-permute interval permutation)
(cond ((not (interval? interval))
- (error "interval-permute: The first argument is not an interval: " interval permutation))
+ (error 'interval-permute "The first argument is not an interval" interval permutation))
((not (permutation? permutation))
- (error "interval-permute: The second argument is not a permutation: " interval permutation))
+ (error 'interval-permute "The second argument is not a permutation" interval permutation))
((not (fx= (%%interval-dimension interval) (vector-length permutation)))
- (error "interval-permute: The dimension of the first argument (an interval) does not equal the length of the second (a permutation): " interval permutation))
+ (error 'interval-permute "The dimension of the first argument (an interval) does not equal the length of the second (a permutation)" interval permutation))
(else
(%%interval-permute interval permutation))))
@@ -349,12 +349,12 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-translate interval translation)
(cond ((not (interval? interval))
- (error "interval-translate: The first argument is not an interval: " interval translation))
+ (error 'interval-translate "The first argument is not an interval" interval translation))
((not (translation? translation))
- (error "interval-translate: The second argument is not a vector of exact integers: " interval translation))
+ (error 'interval-translate "The second argument is not a vector of exact integers" interval translation))
((not (fx= (%%interval-dimension interval)
(vector-length translation)))
- (error "interval-translate: The dimension of the first argument (an interval) does not equal the length of the second (a vector): " interval translation))
+ (error 'interval-translate "The dimension of the first argument (an interval) does not equal the length of the second (a vector)" interval translation))
(else
(%%interval-translate interval translation))))
@@ -373,13 +373,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-scale interval scales)
(cond ((not (and (interval? interval)
(%%vector-every (lambda (x) (eqv? 0 x)) (%%interval-lower-bounds interval))))
- (error "interval-scale: The first argument is not an interval with all lower bounds zero: " interval scales))
+ (error 'interval-scale "The first argument is not an interval with all lower bounds zero" interval scales))
((not (and (vector? scales)
(%%vector-every (lambda (x) (exact-integer? x)) scales)
(%%vector-every (lambda (x) (positive? x)) scales)))
- (error "interval-scale: The second argument is not a vector of positive, exact, integers: " interval scales))
+ (error 'interval-scale "The second argument is not a vector of positive, exact, integers" interval scales))
((not (fx= (vector-length scales) (%%interval-dimension interval)))
- (error "interval-scale: The dimension of the first argument (an interval) is not equal to the length of the second (a vector): "
+ (error 'interval-scale "The dimension of the first argument (an interval) is not equal to the length of the second (a vector)"
interval scales))
(else
(%%interval-scale interval scales))))
@@ -391,30 +391,30 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-cartesian-product interval #!rest intervals)
(let ((intervals (cons interval intervals)))
(cond ((not (%%every interval? intervals))
- (apply error "interval-cartesian-product: Not all arguments are intervals: " intervals))
+ (apply error 'interval-cartesian-product "Not all arguments are intervals" intervals))
(else
(%%interval-cartesian-product intervals)))))
(define (interval-dilate interval lower-diffs upper-diffs)
(cond ((not (interval? interval))
- (error "interval-dilate: The first argument is not an interval: " interval lower-diffs upper-diffs))
+ (error 'interval-dilate "The first argument is not an interval" interval lower-diffs upper-diffs))
((not (and (vector? lower-diffs)
(%%vector-every (lambda (x) (exact-integer? x)) lower-diffs)))
- (error "interval-dilate: The second argument is not a vector of exact integers: " interval lower-diffs upper-diffs))
+ (error 'interval-dilate "The second argument is not a vector of exact integers" interval lower-diffs upper-diffs))
((not (and (vector? upper-diffs)
(%%vector-every (lambda (x) (exact-integer? x)) upper-diffs)))
- (error "interval-dilate: The third argument is not a vector of exact integers: " interval lower-diffs upper-diffs))
+ (error 'interval-dilate "The third argument is not a vector of exact integers" interval lower-diffs upper-diffs))
((not (and (fx= (vector-length lower-diffs)
(vector-length upper-diffs))
(fx= (vector-length upper-diffs)
(%%interval-dimension interval))))
- (error "interval-dilate: The second and third arguments must have the same length as the dimension of the first argument: " interval lower-diffs upper-diffs))
+ (error 'interval-dilate "The second and third arguments must have the same length as the dimension of the first argument" interval lower-diffs upper-diffs))
(else
(let ((new-lower-bounds (vector-map (lambda (x y) (+ x y)) (%%interval-lower-bounds interval) lower-diffs))
(new-upper-bounds (vector-map (lambda (x y) (+ x y)) (%%interval-upper-bounds interval) upper-diffs)))
(if (%%vector-every (lambda (x y) (< x y)) new-lower-bounds new-upper-bounds)
(%%finish-interval new-lower-bounds new-upper-bounds)
- (error "interval-dilate: The resulting interval is empty: " interval lower-diffs upper-diffs))))))
+ (error 'interval-dilate "The resulting interval is empty" interval lower-diffs upper-diffs))))))
(define (%%interval-volume interval)
(or (%%interval-%%volume interval)
@@ -434,7 +434,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-volume interval)
(cond ((not (interval? interval))
- (error "interval-volume: The argument is not an interval: " interval))
+ (error 'interval-volume "The argument is not an interval" interval))
(else
(%%interval-volume interval))))
@@ -456,7 +456,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval= interval1 interval2)
(cond ((not (and (interval? interval1)
(interval? interval2)))
- (error "interval=: Not all arguments are intervals: " interval1 interval2))
+ (error 'interval= "Not all arguments are intervals" interval1 interval2))
(else
(%%interval= interval1 interval2))))
@@ -468,10 +468,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-subset? interval1 interval2)
(cond ((not (and (interval? interval1)
(interval? interval2)))
- (error "interval-subset?: Not all arguments are intervals: " interval1 interval2))
+ (error 'interval-subset? "Not all arguments are intervals" interval1 interval2))
((not (fx= (%%interval-dimension interval1)
(%%interval-dimension interval2)))
- (error "interval-subset?: The arguments do not have the same dimension: " interval1 interval2))
+ (error 'interval-subset? "The arguments do not have the same dimension" interval1 interval2))
(else
(%%interval-subset? interval1 interval2))))
@@ -485,14 +485,14 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (null? intervals)
(if (interval? interval)
interval
- (error "interval-intersect: The argument is not an interval: " interval))
+ (error 'interval-intersect "The argument is not an interval" interval))
(let ((intervals (cons interval intervals)))
(cond ((not (%%every interval? intervals))
- (apply error "interval-intersect: Not all arguments are intervals: " intervals))
+ (apply error 'interval-intersect "Not all arguments are intervals" intervals))
((let* ((dims (map %%interval-dimension intervals))
(dim1 (car dims)))
(not (%%every (lambda (dim) (fx= dim dim1)) (cdr dims))))
- (apply error "interval-intersect: Not all arguments have the same dimension: " intervals))
+ (apply error 'interval-intersect "Not all arguments have the same dimension" intervals))
(else
(%%interval-intersect intervals))))))
@@ -534,14 +534,14 @@ OTHER DEALINGS IN THE SOFTWARE.
;; significantly simplifies testing the error checking
(cond ((not (interval? interval))
- (error "interval-contains-multi-index?: The first argument is not an interval: " interval))
+ (error 'interval-contains-multi-index? "The first argument is not an interval" interval))
(else
(let ((multi-index (cons i multi-index-tail)))
(cond ((not (fx= (%%interval-dimension interval)
(length multi-index)))
- (apply error "interval-contains-multi-index?: The dimension of the first argument (an interval) does not match number of indices: " interval multi-index))
+ (apply error 'interval-contains-multi-index? "The dimension of the first argument (an interval) does not match number of indices" interval multi-index))
((not (%%every (lambda (x) (exact-integer? x)) multi-index))
- (apply error "interval-contains-multi-index?: At least one multi-index component is not an exact integer: " interval multi-index))
+ (apply error 'interval-contains-multi-index? "At least one multi-index component is not an exact integer" interval multi-index))
(else
(%%interval-contains-multi-index?-general interval multi-index)))))))
@@ -550,9 +550,9 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-for-each f interval)
(cond ((not (interval? interval))
- (error "interval-for-each: The second argument is not a interval: " interval))
+ (error 'interval-for-each "The second argument is not a interval" interval))
((not (procedure? f))
- (error "interval-for-each: The first argument is not a procedure: " f))
+ (error 'interval-for-each "The first argument is not a procedure" f))
(else
(%%interval-for-each f interval))))
@@ -783,7 +783,7 @@ OTHER DEALINGS IN THE SOFTWARE.
#f
(lambda (bool)
(if (not (boolean? bool))
- (error "specialized-array-default-safe?: The argument is not a boolean: " bool)
+ (error 'specialized-array-default-safe? "The argument is not a boolean" bool)
bool))))
(define specialized-array-default-mutable?
@@ -791,7 +791,7 @@ OTHER DEALINGS IN THE SOFTWARE.
#t
(lambda (bool)
(if (not (boolean? bool))
- (error "specialized-array-default-mutable?: The argument is not a boolean: " bool)
+ (error 'specialized-array-default-mutable? "The argument is not a boolean" bool)
bool))))
@@ -806,9 +806,9 @@ OTHER DEALINGS IN THE SOFTWARE.
(case-lambda
((domain getter)
(cond ((not (interval? domain))
- (error "make-array: The first argument is not an interval: " domain getter))
+ (error 'make-array "The first argument is not an interval" domain getter))
((not (procedure? getter))
- (error "make-array: The second argument is not a procedure: " domain getter))
+ (error 'make-array "The second argument is not a procedure" domain getter))
(else
(make-%%array domain
getter
@@ -821,11 +821,11 @@ OTHER DEALINGS IN THE SOFTWARE.
))))
((domain getter setter)
(cond ((not (interval? domain))
- (error "make-array: The first argument is not an interval: " domain getter setter))
+ (error 'make-array "The first argument is not an interval" domain getter setter))
((not (procedure? getter))
- (error "make-array: The second argument is not a procedure: " domain getter setter))
+ (error 'make-array "The second argument is not a procedure" domain getter setter))
((not (procedure? setter))
- (error "make-array: The third argument is not a procedure: " domain getter setter))
+ (error 'make-array "The third argument is not a procedure" domain getter setter))
(else
(make-%%array domain
getter
@@ -842,13 +842,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-domain obj)
(cond ((not (array? obj))
- (error "array-domain: The argument is not an array: " obj))
+ (error 'array-domain "The argument is not an array" obj))
(else
(%%array-domain obj))))
(define (array-getter obj)
(cond ((not (array? obj))
- (error "array-getter: The argument is not an array: " obj))
+ (error 'array-getter "The argument is not an array" obj))
(else
(%%array-getter obj))))
@@ -857,7 +857,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-dimension array)
(cond ((not (array? array))
- (error "array-dimension: The argument is not an array: " array))
+ (error 'array-dimension "The argument is not an array" array))
(else
(%%array-dimension array))))
@@ -890,7 +890,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-setter obj)
(cond ((not (mutable-array? obj))
- (error "array-setter: The argument is not an mutable array: " obj))
+ (error 'array-setter "The argument is not an mutable array" obj))
(else
(%%array-setter obj))))
@@ -1450,25 +1450,25 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-body obj)
(cond ((not (specialized-array? obj))
- (error "array-body: The argument is not a specialized array: " obj))
+ (error 'array-body "The argument is not a specialized array" obj))
(else
(%%array-body obj))))
(define (array-indexer obj)
(cond ((not (specialized-array? obj))
- (error "array-indexer: The argument is not a specialized array: " obj))
+ (error 'array-indexer "The argument is not a specialized array" obj))
(else
(%%array-indexer obj))))
(define (array-storage-class obj)
(cond ((not (specialized-array? obj))
- (error "array-storage-class: The argument is not a specialized array: " obj))
+ (error 'array-storage-class "The argument is not a specialized array" obj))
(else
(%%array-storage-class obj))))
(define (array-safe? obj)
(cond ((not (specialized-array? obj))
- (error "array-safe?: The argument is not a specialized array: " obj))
+ (error 'array-safe? "The argument is not a specialized array" obj))
(else
(%%array-safe? obj))))
@@ -1591,7 +1591,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-elements-in-order? array)
(cond ((not (specialized-array? array))
- (error "array-elements-in-order?: The argument is not a specialized array: " array))
+ (error 'array-elements-in-order? "The argument is not a specialized array" array))
(else
(%%array-elements-in-order? array))))
@@ -1652,26 +1652,26 @@ OTHER DEALINGS IN THE SOFTWARE.
(case (%%interval-dimension domain)
((1) (lambda (i)
(cond ((not (exact-integer? i))
- (error "array-getter: multi-index component is not an exact integer: " i))
+ (error 'array-getter "multi-index component is not an exact integer" i))
((not (%%interval-contains-multi-index?-1 domain i))
- (error "array-getter: domain does not contain multi-index: " domain i))
+ (error 'array-getter "domain does not contain multi-index" domain i))
(else
(storage-class-getter body (indexer i))))))
((2) (lambda (i j)
(cond ((not (and (exact-integer? i)
(exact-integer? j)))
- (error "array-getter: multi-index component is not an exact integer: " i j))
+ (error 'array-getter "multi-index component is not an exact integer" i j))
((not (%%interval-contains-multi-index?-2 domain i j))
- (error "array-getter: domain does not contain multi-index: " domain i j))
+ (error 'array-getter "domain does not contain multi-index" domain i j))
(else
(storage-class-getter body (indexer i j))))))
((3) (lambda (i j k)
(cond ((not (and (exact-integer? i)
(exact-integer? j)
(exact-integer? k)))
- (error "array-getter: multi-index component is not an exact integer: " i j k))
+ (error 'array-getter "multi-index component is not an exact integer" i j k))
((not (%%interval-contains-multi-index?-3 domain i j k))
- (error "array-getter: domain does not contain multi-index: " domain i j k))
+ (error 'array-getter "domain does not contain multi-index" domain i j k))
(else
(storage-class-getter body (indexer i j k))))))
((4) (lambda (i j k l)
@@ -1679,18 +1679,18 @@ OTHER DEALINGS IN THE SOFTWARE.
(exact-integer? j)
(exact-integer? k)
(exact-integer? l)))
- (error "array-getter: multi-index component is not an exact integer: " i j k l))
+ (error 'array-getter "multi-index component is not an exact integer" i j k l))
((not (%%interval-contains-multi-index?-4 domain i j k l))
- (error "array-getter: domain does not contain multi-index: " domain i j k l))
+ (error 'array-getter "domain does not contain multi-index" domain i j k l))
(else
(storage-class-getter body (indexer i j k l))))))
(else (lambda multi-index
(cond ((not (%%every (lambda (x) (exact-integer? x)) multi-index))
- (apply error "array-getter: multi-index component is not an exact integer: " multi-index))
+ (apply error 'array-getter "multi-index component is not an exact integer" multi-index))
((not (fx= (%%interval-dimension domain) (length multi-index)))
- (apply error "array-getter: multi-index is not the correct dimension: " domain multi-index))
+ (apply error 'array-getter "multi-index is not the correct dimension" domain multi-index))
((not (%%interval-contains-multi-index?-general domain multi-index))
- (apply error "array-getter: domain does not contain multi-index: " domain multi-index))
+ (apply error 'array-getter "domain does not contain multi-index" domain multi-index))
(else
(storage-class-getter body (apply indexer multi-index)))))))
(case (%%interval-dimension domain)
@@ -1705,32 +1705,32 @@ OTHER DEALINGS IN THE SOFTWARE.
(case (%%interval-dimension domain)
((1) (lambda (value i)
(cond ((not (exact-integer? i))
- (error "array-setter: multi-index component is not an exact integer: " i))
+ (error 'array-setter "multi-index component is not an exact integer" i))
((not (%%interval-contains-multi-index?-1 domain i))
- (error "array-setter: domain does not contain multi-index: " domain i))
+ (error 'array-setter "domain does not contain multi-index" domain i))
((not (checker value))
- (error "array-setter: value cannot be stored in body: " value))
+ (error 'array-setter "value cannot be stored in body" value))
(else
(storage-class-setter body (indexer i) value)))))
((2) (lambda (value i j)
(cond ((not (and (exact-integer? i)
(exact-integer? j)))
- (error "array-setter: multi-index component is not an exact integer: " i j))
+ (error 'array-setter "multi-index component is not an exact integer" i j))
((not (%%interval-contains-multi-index?-2 domain i j))
- (error "array-setter: domain does not contain multi-index: " domain i j))
+ (error 'array-setter "domain does not contain multi-index" domain i j))
((not (checker value))
- (error "array-setter: value cannot be stored in body: " value))
+ (error 'array-setter "value cannot be stored in body" value))
(else
(storage-class-setter body (indexer i j) value)))))
((3) (lambda (value i j k)
(cond ((not (and (exact-integer? i)
(exact-integer? j)
(exact-integer? k)))
- (error "array-setter: multi-index component is not an exact integer: " i j k))
+ (error 'array-setter "multi-index component is not an exact integer" i j k))
((not (%%interval-contains-multi-index?-3 domain i j k))
- (error "array-setter: domain does not contain multi-index: " domain i j k))
+ (error 'array-setter "domain does not contain multi-index" domain i j k))
((not (checker value))
- (error "array-setter: value cannot be stored in body: " value))
+ (error 'array-setter "value cannot be stored in body" value))
(else
(storage-class-setter body (indexer i j k) value)))))
((4) (lambda (value i j k l)
@@ -1738,22 +1738,22 @@ OTHER DEALINGS IN THE SOFTWARE.
(exact-integer? j)
(exact-integer? k)
(exact-integer? l)))
- (error "array-setter: multi-index component is not an exact integer: " i j k l))
+ (error 'array-setter "multi-index component is not an exact integer" i j k l))
((not (%%interval-contains-multi-index?-4 domain i j k l))
- (error "array-setter: domain does not contain multi-index: " domain i j k l))
+ (error 'array-setter "domain does not contain multi-index" domain i j k l))
((not (checker value))
- (error "array-setter: value cannot be stored in body: " value))
+ (error 'array-setter "value cannot be stored in body" value))
(else
(storage-class-setter body (indexer i j k l) value)))))
(else (lambda (value . multi-index)
(cond ((not (%%every (lambda (x) (exact-integer? x)) multi-index))
- (apply error "array-setter: multi-index component is not an exact integer: " multi-index))
+ (apply error 'array-setter "multi-index component is not an exact integer" multi-index))
((not (fx= (%%interval-dimension domain) (length multi-index)))
- (apply error "array-setter: multi-index is not the correct dimension: " domain multi-index))
+ (apply error 'array-setter "multi-index is not the correct dimension" domain multi-index))
((not (%%interval-contains-multi-index?-general domain multi-index))
- (apply error "array-setter: domain does not contain multi-index: " domain multi-index))
+ (apply error 'array-setter "domain does not contain multi-index" domain multi-index))
((not (checker value))
- (error "array-setter: value cannot be stored in body: " value))
+ (error 'array-setter "value cannot be stored in body" value))
(else
(storage-class-setter body (apply indexer multi-index) value))))))
(case (%%interval-dimension domain)
@@ -1848,11 +1848,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(safe? (specialized-array-default-safe?)))
;; Returns a mutable specialized-array
(cond ((not (interval? interval))
- (error "make-specialized-array: The first argument is not an interval: " interval))
+ (error 'make-specialized-array "The first argument is not an interval" interval))
((not (storage-class? storage-class))
- (error "make-specialized-array: The second argument is not a storage-class: " interval storage-class))
+ (error 'make-specialized-array "The second argument is not a storage-class" interval storage-class))
((not (boolean? safe?))
- (error "make-specialized-array: The third argument is not a boolean: " interval storage-class safe?))
+ (error 'make-specialized-array "The third argument is not a boolean" interval storage-class safe?))
(else
(%%make-specialized-array interval
storage-class
@@ -1905,7 +1905,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (not (= (%%interval-volume (%%array-domain source))
(%%interval-volume (%%array-domain destination))))
- (error (string-append caller "Arrays must have the same volume: ")
+ (error caller "Arrays must have the same volume"
destination source))
(if (specialized-array? destination)
@@ -2027,9 +2027,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(setter body index item)
(set! index (fx+ index 1)))
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i item))))))
((2)
(let ((index initial-offset))
@@ -2040,9 +2039,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(setter body index item)
(set! index (fx+ index 1)))
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j item))))))
((3)
(let ((index initial-offset))
@@ -2053,9 +2051,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(setter body index item)
(set! index (fx+ index 1)))
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j k item) )))))
((4)
(let ((index initial-offset))
@@ -2066,9 +2063,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(setter body index item)
(set! index (fx+ index 1)))
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j k l item))))))
(else
(let ((index 0))
@@ -2079,9 +2075,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(setter body index item)
(set! index (fx+ index 1)))
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source multi-index item)))))))
domain))
"In order, checks needed"))))
@@ -2096,9 +2091,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(domain
(%%array-domain destination)))
(cond ((not (%%interval= domain (%%array-domain source)))
- (error (string-append
- caller
- "Arrays must have the same domains: ")
+ (error caller
+ "Arrays must have the same domains"
destination source))
((or (eq? (%%array-storage-class destination)
generic-storage-class)
@@ -2131,9 +2125,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (checker item)
(setter item i)
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i item)))))
((2)
(lambda (i j)
@@ -2141,9 +2134,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (checker item)
(setter item i j)
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j item)))))
((3)
(lambda (i j k)
@@ -2151,9 +2143,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (checker item)
(setter item i j k)
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j k item)))))
((4)
(lambda (i j k l)
@@ -2161,9 +2152,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (checker item)
(setter item i j k l)
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source i j k l item)))))
(else
(lambda multi-index
@@ -2171,9 +2161,8 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (checker item)
(apply setter item multi-index)
(error
- (string-append
- caller
- "Not all elements of the source can be stored in destination: ")
+ caller
+ "Not all elements of the source can be stored in destination"
destination source multi-index item))))))
domain)
"Out of order, checks needed"))))
@@ -2181,9 +2170,8 @@ OTHER DEALINGS IN THE SOFTWARE.
;; if any, are built into the setter.
(let ((domain (%%array-domain destination)))
(if (not (%%interval= domain (%%array-domain source)))
- (error (string-append
- caller
- "Arrays must have the same domains: ")
+ (error caller
+ "Arrays must have the same domains"
destination source)
(let* ((setter
(%%array-setter destination))
@@ -2231,7 +2219,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(let ((result (%%make-specialized-array domain
result-storage-class
safe?)))
- (%%move-array-elements result array "array-copy: ")
+ (%%move-array-elements result array 'array-copy)
(if (not mutable?) ;; set the setter to #f if the final array is not mutable
(%%array-setter-set! result #f))
result))
@@ -2243,21 +2231,20 @@ OTHER DEALINGS IN THE SOFTWARE.
(mutable? (specialized-array-default-mutable?))
(safe? (specialized-array-default-safe?)))
(cond ((not (array? array))
- (error "array-copy: The first argument is not an array: " array))
+ (error 'array-copy "The first argument is not an array" array))
((not (storage-class? result-storage-class))
- (error "array-copy: The second argument is not a storage-class: " result-storage-class))
+ (error 'array-copy "The second argument is not a storage-class" result-storage-class))
((not (or (eq? new-domain #f) (%%interval? new-domain)))
- (error "array-copy: The third argument is neither #f nor an interval: " new-domain))
+ (error 'array-copy "The third argument is neither #f nor an interval" new-domain))
((and (%%interval? new-domain)
(not (= (%%interval-volume new-domain)
(%%interval-volume (%%array-domain array)))))
- (error
- "array-copy: The volume of the third argument is not the volume of the domain of the first argument: "
- array result-storage-class new-domain))
+ (error 'array-copy "The volume of the third argument is not the volume of the domain of the first argument"
+ array result-storage-class new-domain))
((not (boolean? mutable?))
- (error "array-copy: The fourth argument is not a boolean: " mutable?))
+ (error 'array-copy "The fourth argument is not a boolean" mutable?))
((not (boolean? safe?))
- (error "array-copy: The fifth argument is not a boolean: " safe?))
+ (error 'array-copy "The fifth argument is not a boolean" safe?))
(else
(%!array-copy array
result-storage-class
@@ -2427,13 +2414,13 @@ OTHER DEALINGS IN THE SOFTWARE.
new-domain
new-domain->old-domain)
(cond ((not (specialized-array? array))
- (error "specialized-array-share: The first argument is not a specialized-array: "
+ (error 'specialized-array-share "The first argument is not a specialized-array"
array new-domain new-domain->old-domain))
((not (interval? new-domain))
- (error "specialized-array-share: The second argument is not an interval: "
+ (error 'specialized-array-share "The second argument is not an interval"
array new-domain new-domain->old-domain))
((not (procedure? new-domain->old-domain))
- (error "specialized-array-share: The third argument is not a procedure: "
+ (error 'specialized-array-share "The third argument is not a procedure"
array new-domain new-domain->old-domain))
(else
(%%specialized-array-share array
@@ -2464,26 +2451,26 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-extract array new-domain)
(cond ((not (array? array))
- (error "array-extract: The first argument is not an array: " array new-domain))
+ (error 'array-extract "The first argument is not an array" array new-domain))
((not (interval? new-domain))
- (error "array-extract: The second argument is not an interval: " array new-domain))
+ (error 'array-extract "The second argument is not an interval" array new-domain))
((not (fx= (%%array-dimension array)
(%%interval-dimension new-domain)))
- (error "array-extract: The dimension of the second argument (an interval) does not equal the dimension of the domain of the first argument (an array): " array new-domain))
+ (error 'array-extract "The dimension of the second argument (an interval) does not equal the dimension of the domain of the first argument (an array)" array new-domain))
((not (%%interval-subset? new-domain (%%array-domain array)))
- (error "array-extract: The second argument (an interval) is not a subset of the domain of the first argument (an array): " array new-domain))
+ (error 'array-extract "The second argument (an interval) is not a subset of the domain of the first argument (an array)" array new-domain))
(else
(%%array-extract array new-domain))))
(define (array-tile array sides)
(cond ((not (array? array))
- (error "array-tile: The first argument is not an array: " array sides))
+ (error 'array-tile "The first argument is not an array" array sides))
((not (and (vector? sides)
(%%vector-every (lambda (x) (and (exact-integer? x) (positive? x))) sides)))
- (error "array-tile: The second argument is not a vector of exact positive integers: " array sides))
+ (error 'array-tile "The second argument is not a vector of exact positive integers" array sides))
((not (fx= (%%array-dimension array)
(vector-length sides)))
- (error "array-tile: The dimension of the first argument (an array) does not equal the length of the second argument (a vector): " array sides))
+ (error 'array-tile "The dimension of the first argument (an array) does not equal the length of the second argument (a vector)" array sides))
(else
(let* ((n
(vector-length sides))
@@ -2536,7 +2523,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(lambda ,args
(if (not (and ,@(map (lambda (arg) `(exact-integer? ,arg)) args)
(,(symbol-append '%%interval-contains-multi-index?- k) result-domain ,@args)))
- (error "array-tile: Index to result array is not valid: " ,@args)
+ (error 'array-tile "Index to result array is not valid" ,@args)
(let* (,@(map (lambda (l j)
`(,l (vector-ref lower-bounds ,j)))
lowers indices)
@@ -2560,7 +2547,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (not (and (fx= (length i) n)
(%%every (lambda (x) (exact-integer? x)) i)
(%%interval-contains-multi-index?-general result-domain i)))
- (apply error "array-tile: Index to result array is not valid: " i)
+ (apply error 'array-tile "Index to result array is not valid" i)
(let* ((i (list->vector i))
(subdomain (%%finish-interval
(vector-map (lambda (l s i)
@@ -2595,7 +2582,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(translation-list (vector->list translation)))
(lambda indices
(cond ((not (fx= (length indices) n))
- (error "The number of indices does not equal the array dimension: " indices))
+ (error "The number of indices does not equal the array dimension" indices))
(else
(apply getter (map - indices translation-list)))))))))
@@ -2624,7 +2611,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(translation-list (vector->list translation)))
(lambda (v . indices)
(cond ((not (fx= (length indices) n))
- (error "The number of indices does not equal the array dimension: " v indices))
+ (error "The number of indices does not equal the array dimension" v indices))
(else
(apply setter v (map - indices translation-list)))))))))
@@ -2645,12 +2632,12 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-translate array translation)
(cond ((not (array? array))
- (error "array-translate: The first argument is not an array: " array translation))
+ (error 'array-translate "The first argument is not an array" array translation))
((not (translation? translation))
- (error "array-translate: The second argument is not a vector of exact integers: " array translation))
+ (error 'array-translate "The second argument is not a vector of exact integers" array translation))
((not (fx= (%%array-dimension array)
(vector-length translation)))
- (error "array-translate: The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector): " array translation))
+ (error 'array-translate "The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector)" array translation))
((specialized-array? array)
(%%specialized-array-translate array translation))
((mutable-array? array)
@@ -2700,7 +2687,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(permutation-inverse (%%permutation-invert permutation)))
(lambda ,(transform-arguments 'indices)
(if (not (fx= (length indices) n))
- (error "number of indices does not equal permutation dimension: " indices permutation)
+ (error "The number of indices does not equal permutation dimension" indices permutation)
(apply ,name ,@(transform-arguments '((%%vector-permute->list (list->vector indices) permutation-inverse)))))))))))
(let ((result
@@ -2726,12 +2713,12 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-permute array permutation)
(cond ((not (array? array))
- (error "array-permute: The first argument is not an array: " array permutation))
+ (error 'array-permute "The first argument is not an array" array permutation))
((not (permutation? permutation))
- (error "array-permute: The second argument is not a permutation: " array permutation))
+ (error 'array-permute "The second argument is not a permutation" array permutation))
((not (fx= (%%array-dimension array)
(vector-length permutation)))
- (error "array-permute: The dimension of the first argument (an array) does not equal the dimension of the second argument (a permutation): " array permutation))
+ (error 'array-permute "The dimension of the first argument (an array) does not equal the dimension of the second argument (a permutation)" array permutation))
(else
(%%array-permute array permutation))))
@@ -2760,22 +2747,22 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (interval-rotate interval dim)
(if (not (interval? interval))
- (error "interval-rotate: The first argument is not an interval: " interval dim)
+ (error 'interval-rotate "The first argument is not an interval" interval dim)
(let ((d (%%interval-dimension interval)))
(if (not (and (fixnum? dim)
(fx< -1 dim)
(fx< dim d)))
- (error "interval-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive): " interval dim)
+ (error 'interval-rotate "The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive)" interval dim)
(%%interval-permute interval (%%rotation->permutation dim d))))))
(define (array-rotate array dim)
(if (not (array? array))
- (error "array-rotate: The first argument is not an array: " array dim)
+ (error 'array-rotate "The first argument is not an array" array dim)
(let ((d (%%array-dimension array)))
(if (not (and (fixnum? dim)
(fx< -1 dim)
(fx< dim d)))
- (error "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): " array dim)
+ (error 'array-rotate "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)" array dim)
(%%array-permute array (%%rotation->permutation dim d))))))
(define-syntax setup-reversed-getters-and-setters
@@ -2841,7 +2828,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(vector->list (%%interval-lower-bounds interval)))))
(lambda ,(transform-arguments 'indices)
(if (not (fx= (length indices) n))
- (error "number of indices does not equal array dimension: " indices)
+ (error "number of indices does not equal array dimension" indices)
(apply ,name ,@(transform-arguments '((map (lambda (i adjust flip?)
(if flip?
(- adjust i)
@@ -2879,7 +2866,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(case-lambda
((array)
(cond ((not (array? array))
- (error "array-reverse: The argument is not an array: " array))
+ (error 'array-reverse "The argument is not an array" array))
(else
(%%array-reverse array
(let ((dim (%%array-dimension array)))
@@ -2888,13 +2875,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(make-vector dim #t)))))))
((array flip?)
(cond ((not (array? array))
- (error "array-reverse: The first argument is not an array: " array flip?))
+ (error 'array-reverse "The first argument is not an array" array flip?))
((not (and (vector? flip?)
(%%vector-every (lambda (x) (boolean? x)) flip?)))
- (error "array-reverse: The second argument is not a vector of booleans: " array flip?))
+ (error 'array-reverse "The second argument is not a vector of booleans" array flip?))
((not (fx= (%%array-dimension array)
(vector-length flip?)))
- (error "array-reverse: The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector of booleans): " array flip?))
+ (error 'array-reverse "The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector of booleans)" array flip?))
(else
(%%array-reverse array flip?))))))
@@ -2974,7 +2961,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(vector->list scales)))
(lambda ,(transformer 'indices)
(if (not (fx= (length indices) n))
- (error "number of indices does not equal array dimension: " indices)
+ (error "number of indices does not equal array dimension" indices)
(apply ,name ,@(transformer '((map (lambda (i s)
(* s i))
indices scales)))))))))))
@@ -3007,13 +2994,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-sample array scales)
(cond ((not (and (array? array)
(%%vector-every (lambda (x) (eqv? x 0)) (%%interval-lower-bounds (%%array-domain array)))))
- (error "array-sample: The first argument is not an array whose domain has zero lower bounds: " array scales))
+ (error 'array-sample "The first argument is not an array whose domain has zero lower bounds" array scales))
((not (and (vector? scales)
(%%vector-every (lambda (x) (exact-integer? x)) scales)
(%%vector-every (lambda (x) (positive? x)) scales)))
- (error "array-sample: The second argument is not a vector of positive, exact, integers: " array scales))
+ (error 'array-sample "The second argument is not a vector of positive, exact, integers" array scales))
((not (fx= (vector-length scales) (%%array-dimension array)))
- (error "array-sample: The dimension of the first argument (an array) is not equal to the length of the second (a vector): "
+ (error 'array-sample "The dimension of the first argument (an array) is not equal to the length of the second (a vector)"
array scales))
((specialized-array? array)
(%%specialized-array-sample array scales))
@@ -3085,11 +3072,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-outer-product combiner array1 array2)
(cond ((not (array? array1))
- (error "array-outer-product: The second argument is not an array: " combiner array1 array2))
+ (error 'array-outer-product "The second argument is not an array" combiner array1 array2))
((not (array? array2))
- (error "array-outer-product: The third argument is not an array: " combiner array1 array2))
+ (error 'array-outer-product "The third argument is not an array" combiner array1 array2))
((not (procedure? combiner))
- (error "array-outer-product: The first argument is not a procedure: " combiner array1 array2))
+ (error 'array-outer-product "The first argument is not a procedure" combiner array1 array2))
(else
(%%array-outer-product combiner array1 array2))))
@@ -3203,11 +3190,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-curry array right-dimension)
(cond ((not (array? array))
- (error "array-curry: The first argument is not an array: " array right-dimension))
+ (error 'array-curry "The first argument is not an array" array right-dimension))
((not (and (fixnum? right-dimension)
(fx< 0 right-dimension)
(fx< right-dimension (%%array-dimension array))))
- (error "array-curry: The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive): " array right-dimension))
+ (error 'array-curry "The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive)" array right-dimension))
((specialized-array? array)
(%%specialized-array-curry array right-dimension))
((mutable-array? array)
@@ -3302,11 +3289,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-map f array #!rest arrays)
(cond ((not (procedure? f))
- (apply error "array-map: The first argument is not a procedure: " f array arrays))
+ (apply error 'array-map "The first argument is not a procedure" f array arrays))
((not (%%every array? (cons array arrays)))
- (apply error "array-map: Not all arguments after the first are arrays: " f array arrays))
+ (apply error 'array-map "Not all arguments after the first are arrays" f array arrays))
((not (%%every (lambda (d) (%%interval= d (%%array-domain array))) (map %%array-domain arrays)))
- (apply error "array-map: Not all arguments after the first have the same domain: " f array arrays))
+ (apply error 'array-map "Not all arguments after the first have the same domain" f array arrays))
(else
(make-array (%%array-domain array)
(%%specialize-function-applied-to-array-getters f array arrays)))))
@@ -3315,11 +3302,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-for-each f array #!rest arrays)
(cond ((not (procedure? f))
- (apply error "array-for-each: The first argument is not a procedure: " f array arrays))
+ (apply error 'array-for-each "The first argument is not a procedure" f array arrays))
((not (%%every array? (cons array arrays)))
- (apply error "array-for-each: Not all arguments after the first are arrays: " f array arrays))
+ (apply error 'array-for-each "Not all arguments after the first are arrays" f array arrays))
((not (%%every (lambda (d) (%%interval= d (%%array-domain array))) (map %%array-domain arrays)))
- (apply error "array-for-each: Not all arguments after the first have the same domain: " f array arrays))
+ (apply error 'array-for-each "Not all arguments after the first have the same domain" f array arrays))
(else
(%%interval-for-each (%%specialize-function-applied-to-array-getters f array arrays)
(%%array-domain array)))))
@@ -3473,22 +3460,22 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-every f array #!rest arrays)
(cond ((not (procedure? f))
- (apply error "array-every: The first argument is not a procedure: " f array arrays))
+ (apply error 'array-every "The first argument is not a procedure" f array arrays))
((not (%%every array? (cons array arrays)))
- (apply error "array-every: Not all arguments after the first are arrays: " f array arrays))
+ (apply error 'array-every "Not all arguments after the first are arrays" f array arrays))
((not (%%every (lambda (d) (%%interval= d (%%array-domain array))) (map %%array-domain arrays)))
- (apply error "array-every: Not all arguments after the first have the same domain: " f array arrays))
+ (apply error 'array-every "Not all arguments after the first have the same domain" f array arrays))
(else
(%%interval-every (%%specialize-function-applied-to-array-getters f array arrays)
(%%array-domain array)))))
(define (array-any f array #!rest arrays)
(cond ((not (procedure? f))
- (apply error "array-any: The first argument is not a procedure: " f array arrays))
+ (apply error 'array-any "The first argument is not a procedure" f array arrays))
((not (%%every array? (cons array arrays)))
- (apply error "array-any: Not all arguments after the first are arrays: " f array arrays))
+ (apply error 'array-any "Not all arguments after the first are arrays" f array arrays))
((not (%%every (lambda (d) (%%interval= d (%%array-domain array))) (map %%array-domain arrays)))
- (apply error "array-any: Not all arguments after the first have the same domain: " f array arrays))
+ (apply error 'array-any "Not all arguments after the first have the same domain" f array arrays))
(else
(%%interval-any (%%specialize-function-applied-to-array-getters f array arrays)
(%%array-domain array)))))
@@ -3499,17 +3486,17 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-fold op id a)
(cond ((not (procedure? op))
- (error "array-fold: The first argument is not a procedure: " op id a))
+ (error 'array-fold "The first argument is not a procedure" op id a))
((not (array? a))
- (error "array-fold: The third argument is not an array: " op id a))
+ (error 'array-fold "The third argument is not an array" op id a))
(else
(%%array-fold op id a))))
(define (array-fold-right op id a)
(cond ((not (procedure? op))
- (error "array-fold-right: The first argument is not a procedure: " op id a))
+ (error 'array-fold-right "The first argument is not a procedure" op id a))
((not (array? a))
- (error "array-fold-right: The third argument is not an array: " op id a))
+ (error 'array-fold-right "The third argument is not an array" op id a))
(else
;; We let array-reverse do a redundant array? check to not generate
;; a new vector of #t's.
@@ -3517,9 +3504,9 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array-reduce sum A)
(cond ((not (array? A))
- (error "array-reduce: The second argument is not an array: " sum A))
+ (error 'array-reduce "The second argument is not an array" sum A))
((not (procedure? sum))
- (error "array-reduce: The first argument is not a procedure: " sum A))
+ (error 'array-reduce "The first argument is not a procedure" sum A))
(else
(case (%%array-dimension A)
((1) (let ((box '())
@@ -3575,7 +3562,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(define (array->list array)
(cond ((not (array? array))
- (error "array->list: The argument is not an array: " array))
+ (error 'array->list "The argument is not an array" array))
(else
(array-fold-right cons '() array))))
@@ -3586,15 +3573,15 @@ OTHER DEALINGS IN THE SOFTWARE.
(mutable? (specialized-array-default-mutable?))
(safe? (specialized-array-default-safe?)))
(cond ((not (list? l))
- (error "list->array: The first argument is not a list: " l interval))
+ (error 'list->array "The first argument is not a list" l interval))
((not (interval? interval))
- (error "list->array: The second argument is not an interval: " l interval))
+ (error 'list->array "The second argument is not an interval" l interval))
((not (storage-class? result-storage-class))
- (error "list->array: The third argument is not a storage-class: " l interval result-storage-class))
+ (error 'list->array "The third argument is not a storage-class" l interval result-storage-class))
((not (boolean? mutable?))
- (error "list->array: The fourth argument is not a boolean: " l interval result-storage-class mutable?))
+ (error 'list->array "The fourth argument is not a boolean" l interval result-storage-class mutable?))
((not (boolean? safe?))
- (error "list->array: The fifth argument is not a boolean: " l interval result-storage-class mutable? safe?))
+ (error 'list->array "The fifth argument is not a boolean" l interval result-storage-class mutable? safe?))
(else
(let* ((checker
(storage-class-checker result-storage-class))
@@ -3616,34 +3603,34 @@ OTHER DEALINGS IN THE SOFTWARE.
(if (not mutable?)
(%%array-setter-set! result #f))
result)
- (error "list->array: The length of the first argument does not equal the volume of the second: " l interval))
+ (error 'list->array "The length of the first argument does not equal the volume of the second" l interval))
(let ((item (car local)))
(if (checker item)
(begin
(setter body i item)
(loop (fx+ i 1)
(cdr local)))
- (error "list->array: Not every element of the list can be stored in the body of the array: " l interval item)))))))))
+ (error 'list->array "Not every element of the list can be stored in the body of the array" l interval item)))))))))
(define (array-assign! destination source)
(cond ((not (mutable-array? destination))
- (error "array-assign!: The destination is not a mutable array: " destination source))
+ (error 'array-assign! "The destination is not a mutable array" destination source))
((not (array? source))
- (error "array-assign!: The source is not an array: " destination source))
+ (error 'array-assign! "The source is not an array" destination source))
((interval= (%%array-domain destination)
(%%array-domain source))
- (%%move-array-elements destination source "array-assign!: ")
+ (%%move-array-elements destination source 'array-assign!)
destination)
((not (fx= (%%interval-volume (%%array-domain destination))
(%%interval-volume (%%array-domain source))))
- (error "array-assign!: The destination and source do not have the same number of elements: " destination source))
+ (error 'array-assign! "The destination and source do not have the same number of elements" destination source))
((not (specialized-array? destination))
- (error "array-assign!: The destination and source do not have the same domains, and the destination is not a specialized array: " destination source))
+ (error 'array-assign! "The destination and source do not have the same domains, and the destination is not a specialized array" destination source))
((not (%%array-elements-in-order? destination))
- (error "array-assign!: The destination and source do not have the same domains, and the elements of the destination are not stored adjacently and in order: "
+ (error 'array-assign "The destination and source do not have the same domains, and the elements of the destination are not stored adjacently and in order"
destination source))
(else
- (%%move-array-elements destination source "array-assign!: ")
+ (%%move-array-elements destination source 'array-assign!)
destination)))
;;; Because array-ref and array-set! have variable number of arguments, and
@@ -3658,46 +3645,46 @@ OTHER DEALINGS IN THE SOFTWARE.
(case-lambda
((A i0)
(if (not (array? A))
- (error "array-ref: The first argument is not an array: " A i0)
+ (error 'array-ref "The first argument is not an array" A i0)
((%%array-getter A) i0)))
((A i0 i1)
(if (not (array? A))
- (error "array-ref: The first argument is not an array: " A i0 i1)
+ (error 'array-ref "The first argument is not an array" A i0 i1)
((%%array-getter A) i0 i1)))
((A i0 i1 i2)
(if (not (array? A))
- (error "array-ref: The first argument is not an array: " A i0 i1 i2)
+ (error 'array-ref "The first argument is not an array" A i0 i1 i2)
((%%array-getter A) i0 i1 i2)))
((A i0 i1 i2 i3)
(if (not (array? A))
- (error "array-ref: The first argument is not an array: " A i0 i1 i2 i3)
+ (error 'array-ref "The first argument is not an array" A i0 i1 i2 i3)
((%%array-getter A) i0 i1 i2 i3)))
((A i0 i1 i2 i3 . i-tail)
(if (not (array? A))
- (apply error "array-ref: The first argument is not an array: " A i0 i1 i2 i3 i-tail)
+ (apply error 'array-ref "The first argument is not an array" A i0 i1 i2 i3 i-tail)
(apply (%%array-getter A) i0 i1 i2 i3 i-tail)))))
(define array-set!
(case-lambda
((A v i0)
(if (not (mutable-array? A))
- (error "array-set!: The first argument is not a mutable array: " A v i0)
+ (error 'array-set! "The first argument is not a mutable array" A v i0)
((%%array-setter A) v i0)))
((A v i0 i1)
(if (not (mutable-array? A))
- (error "array-set!: The first argument is not a mutable array: " A v i0 i1)
+ (error 'array-set! "The first argument is not a mutable array" A v i0 i1)
((%%array-setter A) v i0 i1)))
((A v i0 i1 i2)
(if (not (mutable-array? A))
- (error "array-set!: The first argument is not a mutable array: " A v i0 i1 i2)
+ (error 'array-set! "The first argument is not a mutable array" A v i0 i1 i2)
((%%array-setter A) v i0 i1 i2)))
((A v i0 i1 i2 i3)
(if (not (mutable-array? A))
- (error "array-set!: The first argument is not a mutable array: " A v i0 i1 i2 i3)
+ (error 'array-set! "The first argument is not a mutable array" A v i0 i1 i2 i3)
((%%array-setter A) v i0 i1 i2 i3)))
((A v i0 i1 i2 i3 . i-tail)
(if (not (mutable-array? A))
- (apply error "array-set!: The first argument is not a mutable array: " A v i0 i1 i2 i3 i-tail)
+ (apply error 'array-set! "The first argument is not a mutable array" A v i0 i1 i2 i3 i-tail)
(apply (%%array-setter A) v i0 i1 i2 i3 i-tail)))))
#|
@@ -3761,14 +3748,14 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(helper 0 0)))
(cond ((not (specialized-array? array))
- (error "specialized-array-reshape: The first argument is not a specialized array: " array new-domain))
+ (error 'specialized-array-reshape "The first argument is not a specialized array" array new-domain))
((not (interval? new-domain))
- (error "specialized-array-reshape: The second argument is not an interval " array new-domain))
+ (error 'specialized-array-reshape "The second argument is not an interval" array new-domain))
((not (fx= (%%interval-volume (%%array-domain array))
(%%interval-volume new-domain)))
- (error "specialized-array-reshape: The volume of the domain of the first argument is not equal to the volume of the second argument: " array new-domain))
+ (error 'specialized-array-reshape "The volume of the domain of the first argument is not equal to the volume of the second argument" array new-domain))
((not (boolean? copy-on-failure?))
- (error "specialized-array-reshape: The third argument is not a boolean: " array new-domain copy-on-failure?))
+ (error 'specialized-array-reshape "The third argument is not a boolean" array new-domain copy-on-failure?))
(else
(let* ((indexer
(%%array-indexer array))
@@ -3865,7 +3852,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
new-domain
(mutable-array? array)
(array-safe? array))
- (error "specialized-array-reshape: Requested reshaping is impossible: " array new-domain))
+ (error 'specialized-array-reshape "Requested reshaping is impossible" array new-domain))
(loop-3 (fx+ ok 1)))
(begin
(vector-set! newstrides (fx- nj 1) (vector-ref oldstrides (fx- oj 1)))
diff --git a/srfi-179.egg b/srfi-179.egg
index 802e4a2..23bb975 100644
--- a/srfi-179.egg
+++ b/srfi-179.egg
@@ -7,4 +7,6 @@
(test-dependencies test srfi-1 srfi-133 srfi-160)
(components
(extension srfi-179
- (csc-options -O3))))
+ (csc-options -O3)
+ (source-dependencies "generic-arrays.scm"
+ "shim.scm"))))
diff --git a/srfi-179.release-info b/srfi-179.release-info
index 6cf6bfb..98cbaa0 100644
--- a/srfi-179.release-info
+++ b/srfi-179.release-info
@@ -1,4 +1,5 @@
(uri targz "https://code.dieggsy.com/{egg-name}/snapshot/{egg-name}-{egg-release}.tar.gz")
+(release "0.2.3")
(release "0.2.2")
(release "0.2.1")
(release "0.2.0")
diff --git a/tests/run.scm b/tests/run.scm
index ed2cd7d..52dfc66 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -46,7 +46,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(only chicken.pretty-print pretty-print)
(only srfi.160.f64 f64vector-map!))
-(current-test-verbosity #f)
+(current-test-verbosity #t)
;;module defs
(include-relative "../shim.scm")
@@ -164,46 +164,46 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "Interval error tests"
(test (make-interval 1 '#(3 4))
- "make-interval: The first argument is not a nonempty vector of exact integers: ")
+ "The first argument is not a nonempty vector of exact integers")
(test (make-interval '#(1 1) 3)
- "make-interval: The second argument is not a nonempty vector of exact integers: ")
+ "The second argument is not a nonempty vector of exact integers")
(test (make-interval '#(1 1) '#(3))
- "make-interval: The first and second arguments are not the same length: ")
+ "The first and second arguments are not the same length")
(test (make-interval '#() '#())
- "make-interval: The first argument is not a nonempty vector of exact integers: ")
+ "The first argument is not a nonempty vector of exact integers")
(test (make-interval '#(1.) '#(1))
- "make-interval: The first argument is not a nonempty vector of exact integers: ")
+ "The first argument is not a nonempty vector of exact integers")
(test (make-interval '#(1 #f) '#(1 2))
- "make-interval: The first argument is not a nonempty vector of exact integers: ")
+ "The first argument is not a nonempty vector of exact integers")
(test (make-interval '#(1) '#(1.))
- "make-interval: The second argument is not a nonempty vector of exact integers: ")
+ "The second argument is not a nonempty vector of exact integers")
(test (make-interval '#(1 1) '#(1 #f))
- "make-interval: The second argument is not a nonempty vector of exact integers: ")
+ "The second argument is not a nonempty vector of exact integers")
(test (make-interval '#(1) '#(1))
- "make-interval: Each lower-bound must be less than the associated upper-bound: ")
+ "Each lower-bound must be less than the associated upper-bound")
(test (make-interval '#(1 2 3) '#(4 2 6))
- "make-interval: Each lower-bound must be less than the associated upper-bound: ")
+ "Each lower-bound must be less than the associated upper-bound")
(test (make-interval 1)
- "make-interval: The argument is not a nonempty vector of positive exact integers: ")
+ "The argument is not a nonempty vector of positive exact integers")
(test (make-interval '#())
- "make-interval: The argument is not a nonempty vector of positive exact integers: ")
+ "The argument is not a nonempty vector of positive exact integers")
(test (make-interval '#(1.))
- "make-interval: The argument is not a nonempty vector of positive exact integers: ")
+ "The argument is not a nonempty vector of positive exact integers")
(test (make-interval '#(-1))
- "make-interval: The argument is not a nonempty vector of positive exact integers: "))
+ "The argument is not a nonempty vector of positive exact integers"))
(test-group "interval result tests"
@@ -226,7 +226,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-dimension error tests"
(test (interval-dimension 1)
- "interval-dimension: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-dimension result tests"
@@ -236,52 +236,52 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-lower-bound error tests"
(test (interval-lower-bound 1 0)
- "interval-lower-bound: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-lower-bound (make-interval '#(1 2 3) '#(4 5 6)) #f)
- "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-lower-bound (make-interval '#(1 2 3) '#(4 5 6)) 1.)
- "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-lower-bound (make-interval '#(1 2 3) '#(4 5 6)) -1)
- "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-lower-bound (make-interval '#(1 2 3) '#(4 5 6)) 3)
- "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-lower-bound (make-interval '#(1 2 3) '#(4 5 6)) 4)
- "interval-lower-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): "))
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)"))
(test-group "interval-upper-bound error tests"
(test (interval-upper-bound 1 0)
- "interval-upper-bound: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-upper-bound (make-interval '#(1 2 3) '#(4 5 6)) #f)
- "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-upper-bound (make-interval '#(1 2 3) '#(4 5 6)) 1.)
- "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-upper-bound (make-interval '#(1 2 3) '#(4 5 6)) -1)
- "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-upper-bound (make-interval '#(1 2 3) '#(4 5 6)) 3)
- "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): ")
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)")
(test (interval-upper-bound (make-interval '#(1 2 3) '#(4 5 6)) 4)
- "interval-upper-bound: The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive): "))
+ "The second argument is not an exact integer between 0 (inclusive) and (interval-dimension interval) (exclusive)"))
(test-group "interval-lower-bounds->list error tests"
(test (interval-lower-bounds->list 1)
- "interval-lower-bounds->list: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-upper-bounds->list error tests"
(test (interval-upper-bounds->list #f)
- "interval-upper-bounds->list: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-lower-bound, interval-upper-bound, interval-lower-bounds->list, and interval-upper-bounds->list result tests"
@@ -306,12 +306,12 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-lower-bounds->vector error tests"
(test (interval-lower-bounds->vector 1)
- "interval-lower-bounds->vector: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-upper-bounds-> error tests"
(test (interval-upper-bounds->vector #f)
- "interval-upper-bounds->vector: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-lower-bound, interval-upper-bound, interval-lower-bounds->vector, and interval-upper-bounds->vector result tests"
@@ -334,23 +334,23 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-projections error tests"
(test (interval-projections 1 1)
- "interval-projections: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-projections (make-interval '#(0) '#(1)) #t)
- "interval-projections: The dimension of the first argument is not greater than 1: " )
+ "The dimension of the first argument is not greater than 1" )
(test (interval-projections (make-interval '#(0 0) '#(1 1)) 1/2)
- "interval-projections: The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive)")
(test (interval-projections (make-interval '#(0 0) '#(1 1)) 1.)
- "interval-projections: The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive)")
(test (interval-projections (make-interval '#(0 0) '#(1 1)) 0)
- "interval-projections: The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive)")
(test (interval-projections (make-interval '#(0 0) '#(1 1)) 2)
- "interval-projections: The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive): "))
+ "The second argument is not an exact integer between 0 and the dimension of the first argument (exclusive)"))
;; (pp "interval-projections result tests")
@@ -377,7 +377,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-volume error tests"
(test (interval-volume #f)
- "interval-volume: The argument is not an interval: "))
+ "The argument is not an interval"))
(test-group "interval-volume result tests"
@@ -392,10 +392,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval= error tests"
(test (interval= #f (make-interval '#(1 2 3) '#(4 5 6)))
- "interval=: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(test (interval= (make-interval '#(1 2 3) '#(4 5 6)) #f)
- "interval=: Not all arguments are intervals: "))
+ "Not all arguments are intervals"))
(test-group "interval= result tests"
@@ -415,14 +415,14 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-subset? error tests"
(test (interval-subset? #f (make-interval '#(1 2 3) '#(4 5 6)))
- "interval-subset?: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(test (interval-subset? (make-interval '#(1 2 3) '#(4 5 6)) #f)
- "interval-subset?: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(test (interval-subset? (make-interval '#(1) '#(2))
(make-interval '#(0 0) '#(1 2)))
- "interval-subset?: The arguments do not have the same dimension: "))
+ "The arguments do not have the same dimension"))
(test-group "interval-subset? result tests"
@@ -442,13 +442,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-contains-multi-index? error tests"
(test (interval-contains-multi-index? 1 1)
- "interval-contains-multi-index?: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-contains-multi-index? (make-interval '#(1 2 3) '#(4 5 6)) 1)
- "interval-contains-multi-index?: The dimension of the first argument (an interval) does not match number of indices: ")
+ "The dimension of the first argument (an interval) does not match number of indices")
(test (interval-contains-multi-index? (make-interval '#(1 2 3) '#(4 5 6)) 1 1/2 0.1)
- "interval-contains-multi-index?: At least one multi-index component is not an exact integer: "))
+ "At least one multi-index component is not an exact integer"))
(test-group "interval-contains-multi-index? result tests"
@@ -468,10 +468,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "interval-for-each error tests"
(test (interval-for-each (lambda (x) x) 1)
- "interval-for-each: The second argument is not a interval: ")
+ "The second argument is not a interval")
(test (interval-for-each 1 (make-interval '#(3) '#(4)))
- "interval-for-each: The first argument is not a procedure: "))
+ "The first argument is not a procedure"))
(define (local-iota a b)
(if (= a b)
@@ -512,17 +512,17 @@ OTHER DEALINGS IN THE SOFTWARE.
(let ((interval (make-interval '#(0 0) '#(100 100))))
(test (interval-dilate interval 'a '#(-10 10))
- "interval-dilate: The second argument is not a vector of exact integers: ")
+ "The second argument is not a vector of exact integers")
(test (interval-dilate 'a '#(10 10) '#(-10 -10))
- "interval-dilate: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-dilate interval '#(10 10) 'a)
- "interval-dilate: The third argument is not a vector of exact integers: " )
+ "The third argument is not a vector of exact integers" )
(test (interval-dilate interval '#(10) '#(-10 -10))
- "interval-dilate: The second and third arguments must have the same length as the dimension of the first argument: ")
+ "The second and third arguments must have the same length as the dimension of the first argument")
(test (interval-dilate interval '#(10 10) '#( -10))
- "interval-dilate: The second and third arguments must have the same length as the dimension of the first argument: ")
+ "The second and third arguments must have the same length as the dimension of the first argument")
(test (interval-dilate interval '#(100 100) '#(-100 -100))
- "interval-dilate: The resulting interval is empty: ")))
+ "The resulting interval is empty")))
;;; define random-interval, random-multi-index
@@ -593,15 +593,15 @@ OTHER DEALINGS IN THE SOFTWARE.
(newline))
(array-curry A 1)))
(else
- (error "array-display can't handle > 2 dimensions: " A))))
+ (error "array-display can't handle > 2 dimensions" A))))
(test-group "array error tests"
(test (make-array 1 values)
- "make-array: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (make-array (make-interval '#(3) '#(4)) 1)
- "make-array: The second argument is not a procedure: "))
+ "The second argument is not a procedure"))
(test-group "array result tests"
@@ -619,10 +619,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-domain and array-getter error tests"
(test (array-domain #f)
- "array-domain: The argument is not an array: ")
+ "The argument is not an array")
(test (array-getter #f)
- "array-getter: The argument is not an array: "))
+ "The argument is not an array"))
(test-group "array?, array-domain, and array-getter result tests"
@@ -659,7 +659,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-setter error tests"
(test (array-setter #f)
- "array-setter: The argument is not an mutable array: "))
+ "The argument is not an mutable array"))
(test-group "mutable-array? and array-setter result tests"
@@ -761,24 +761,24 @@ OTHER DEALINGS IN THE SOFTWARE.
values
values)))
(test (array-body a)
- "array-body: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
(test (array-indexer a)
- "array-indexer: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
(test (array-storage-class a)
- "array-storage-class: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
(test (array-safe? a)
- "array-safe?: The argument is not a specialized array: ")))
+ "The argument is not a specialized array")))
(test-group "specialized-array error tests"
(test (make-specialized-array 'a)
- "make-specialized-array: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (make-specialized-array (make-interval '#(0) '#(10)) 'a)
- "make-specialized-array: The second argument is not a storage-class: ")
+ "The second argument is not a storage-class")
(test (make-specialized-array (make-interval '#(0) '#(10)) generic-storage-class 'a)
- "make-specialized-array: The third argument is not a boolean: "))
+ "The third argument is not a boolean"))
(define random-storage-class-and-initializer
(let* ((storage-classes
@@ -827,13 +827,13 @@ OTHER DEALINGS IN THE SOFTWARE.
;; use the array contents, just the indexers, and it saves storage.
(test (array-elements-in-order? 1)
- "array-elements-in-order?: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
(test (array-elements-in-order? (make-array (make-interval '#(1 2)) list))
- "array-elements-in-order?: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
(test (array-elements-in-order? (make-array (make-interval '#(1 2)) list list)) ;; not valid setter
- "array-elements-in-order?: The argument is not a specialized array: ")
+ "The argument is not a specialized array")
;; all these are true, we'll have to see how to screw it up later.
@@ -1075,18 +1075,18 @@ OTHER DEALINGS IN THE SOFTWARE.
(test (%%move-array-elements (array-reverse (make-specialized-array (make-interval '#(2 2))))
(make-array (make-interval '#(1 4)) list)
- "")
- "Arrays must have the same domains: ")
+ 'test)
+ "Arrays must have the same domains")
(test (%%move-array-elements (make-specialized-array (make-interval '#(2 2)))
(make-array (make-interval '#(1 5)) list)
- "")
- "Arrays must have the same volume: ")
+ 'test)
+ "Arrays must have the same volume")
(test (%%move-array-elements (make-array (make-interval '#(2 2)) list list) ;; not a valid setter
(make-array (make-interval '#(1 4)) list)
- "")
- "Arrays must have the same domains: ")
+ 'test)
+ "Arrays must have the same domains")
(do ((d 1 (fx+ d 1)))
((= d 6))
@@ -1144,7 +1144,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(array-getter specialized-reversed-source)
(array-setter specialized-reversed-source))))
;; specialized-to-specialized, use fast copy
- (test (%%move-array-elements specialized-destination specialized-source "test: ")
+ (test (%%move-array-elements specialized-destination specialized-source 'test)
(if (equal? storage-class u1-storage-class)
;; no copier
"In order, no checks needed"
@@ -1152,13 +1152,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(test (myarray= specialized-source specialized-destination)
#t)
;; fast copying between specialized of the same volume
- (test (%%move-array-elements specialized-destination specialized-reversed-source "test: ")
+ (test (%%move-array-elements specialized-destination specialized-reversed-source 'test)
(if (equal? storage-class u1-storage-class)
;; no copier
"In order, no checks needed"
"Block copy"))
;; copy to adjacent elements of destination, checking needed
- (test (%%move-array-elements specialized-destination source "test: ")
+ (test (%%move-array-elements specialized-destination source 'test)
(if (equal? storage-class generic-storage-class)
"In order, no checks needed, generic-storage-class"
"In order, checks needed"))
@@ -1166,7 +1166,7 @@ OTHER DEALINGS IN THE SOFTWARE.
#t)
;; copy to adjacent elements of destination, no checking needed
;; arrays of different shapes
- (test (%%move-array-elements specialized-destination rotated-specialized-source "test: ")
+ (test (%%move-array-elements specialized-destination rotated-specialized-source 'test)
(if (and (array-elements-in-order? rotated-specialized-source) ;; one dimension
(not (equal? storage-class u1-storage-class)))
"Block copy"
@@ -1178,7 +1178,7 @@ OTHER DEALINGS IN THE SOFTWARE.
#t)
;; copy to adjacent elements of destination, checking needed
;; arrays of different shapes
- (test (%%move-array-elements specialized-destination rotated-source "test: ")
+ (test (%%move-array-elements specialized-destination rotated-source 'test)
(if (equal? storage-class generic-storage-class)
"In order, no checks needed, generic-storage-class"
"In order, checks needed"))
@@ -1186,14 +1186,14 @@ OTHER DEALINGS IN THE SOFTWARE.
(array->list specialized-destination))
#t)
;; copy to non-adjacent elements of destination, no checking needed
- (test (%%move-array-elements (array-reverse specialized-destination) specialized-source "test: ")
+ (test (%%move-array-elements (array-reverse specialized-destination) specialized-source 'test)
(if (array-elements-in-order? (array-reverse specialized-destination))
"Out of order, no checks needed"
"Out of order, no checks needed" ))
(test (myarray= specialized-source (array-reverse specialized-destination))
#t)
;; copy to non-specialized array
- (test (%%move-array-elements destination source "test: ")
+ (test (%%move-array-elements destination source 'test)
"Destination not specialized array")
(test (myarray= destination source)
#t)
@@ -1202,31 +1202,31 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-copy error tests"
(test (array-copy #f generic-storage-class)
- "array-copy: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
#f)
- "array-copy: The second argument is not a storage-class: ")
+ "The second argument is not a storage-class")
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
generic-storage-class
'a)
- "array-copy: The third argument is neither #f nor an interval: ")
+ "The third argument is neither #f nor an interval")
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
generic-storage-class
(make-interval '#(10)))
- "array-copy: The volume of the third argument is not the volume of the domain of the first argument: ")
+ "The volume of the third argument is not the volume of the domain of the first argument")
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
generic-storage-class
#f
'a)
- "array-copy: The fourth argument is not a boolean: ")
+ "The fourth argument is not a boolean")
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
@@ -1234,40 +1234,40 @@ OTHER DEALINGS IN THE SOFTWARE.
#f
#f
'a)
- "array-copy: The fifth argument is not a boolean: ")
+ "The fifth argument is not a boolean")
;; We gotta make sure than the error checks work in all dimensions ...
(test (array-copy (make-array (make-interval '#(1) '#(2))
list)
u16-storage-class)
- "array-copy: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (array-copy (make-array (make-interval '#(1 1) '#(2 2))
list)
u16-storage-class)
- "array-copy: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (array-copy (make-array (make-interval '#(1 1 1) '#(2 2 2))
list)
u16-storage-class)
- "array-copy: Not all elements of the source can be stored in destination: " )
+ "Not all elements of the source can be stored in destination" )
(test (array-copy (make-array (make-interval '#(1 1 1 1) '#(2 2 2 2))
list)
u16-storage-class)
- "array-copy: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (array-copy (make-array (make-interval '#(1 1 1 1 1) '#(2 2 2 2 2))
list)
u16-storage-class)
- "array-copy: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (specialized-array-default-safe? 'a)
- "specialized-array-default-safe?: The argument is not a boolean: ")
+ "The argument is not a boolean")
(test (specialized-array-default-mutable? 'a)
- "specialized-array-default-mutable?: The argument is not a boolean: ")
+ "The argument is not a boolean")
(let ((mutable-default (specialized-array-default-mutable?)))
(specialized-array-default-mutable? #f)
@@ -1275,9 +1275,9 @@ OTHER DEALINGS IN THE SOFTWARE.
((= i 6))
(let ((A (array-copy (make-array (make-interval (make-vector i 2)) (lambda args 10)))))
(test (apply array-set! A 0 (make-list i 0))
- "array-set!: The first argument is not a mutable array: ")
+ "The first argument is not a mutable array")
(test (array-assign! A A)
- "array-assign!: The destination is not a mutable array: ")))
+ "The destination is not a mutable array")))
(specialized-array-default-mutable? mutable-default)))
@@ -1374,62 +1374,62 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-map error tests"
(test (array-map 1 #f)
- "array-map: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-map list 1 (make-array (make-interval '#(3) '#(4))
list))
- "array-map: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-map list (make-array (make-interval '#(3) '#(4))
list) 1)
- "array-map: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-map list
(make-array (make-interval '#(3) '#(4))
list)
(make-array (make-interval '#(3 4) '#(4 5))
list))
- "array-map: Not all arguments after the first have the same domain: "))
+ "Not all arguments after the first have the same domain"))
(test-group "array-every and array-any error tests"
(test (array-every 1 2)
- "array-every: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-every list 1)
- "array-every: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-every list
(make-array (make-interval '#(3) '#(4))
list)
1)
- "array-every: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-every list
(make-array (make-interval '#(3) '#(4))
list)
(make-array (make-interval '#(3 4) '#(4 5))
list))
- "array-every: Not all arguments after the first have the same domain: ")
+ "Not all arguments after the first have the same domain")
(test (array-any 1 2)
- "array-any: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-any list 1)
- "array-any: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-any list
(make-array (make-interval '#(3) '#(4))
list)
1)
- "array-any: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-any list
(make-array (make-interval '#(3) '#(4))
list)
(make-array (make-interval '#(3 4) '#(4 5))
list))
- "array-any: Not all arguments after the first have the same domain: "))
+ "Not all arguments after the first have the same domain"))
(test-group "array-every and array-any"
@@ -1511,36 +1511,36 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-fold error tests"
(test (array-fold 1 1 1)
- "array-fold: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-fold list 1 1)
- "array-fold: The third argument is not an array: ")
+ "The third argument is not an array")
(test (array-fold-right 1 1 1)
- "array-fold-right: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-fold-right list 1 1)
- "array-fold-right: The third argument is not an array: "))
+ "The third argument is not an array"))
(test-group "array-for-each error tests"
(test (array-for-each 1 #f)
- "array-for-each: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-for-each list 1 (make-array (make-interval '#(3) '#(4))
list))
- "array-for-each: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-for-each list (make-array (make-interval '#(3) '#(4))
list) 1)
- "array-for-each: Not all arguments after the first are arrays: ")
+ "Not all arguments after the first are arrays")
(test (array-for-each list
(make-array (make-interval '#(3) '#(4))
list)
(make-array (make-interval '#(3 4) '#(4 5))
list))
- "array-for-each: Not all arguments after the first have the same domain: "))
+ "Not all arguments after the first have the same domain"))
(test-group "array-map, array-fold, and array-for-each result tests"
@@ -1677,10 +1677,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-reduce tests"
(test (array-reduce 'a 'a)
- "array-reduce: The second argument is not an array: ")
+ "The second argument is not an array")
(test (array-reduce 'a (make-array (make-interval '#(1) '#(3)) list))
- "array-reduce: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
;;; OK, how to test array-reduce?
@@ -1799,16 +1799,16 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "Some array-curry tests."
(test (array-curry 'a 1)
- "array-curry: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-curry (make-array (make-interval '#(0) '#(1)) list) 'a)
- "array-curry: The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive): ")
+ "The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive)")
(test (array-curry (make-array (make-interval '#(0 0) '#(1 1)) list) 0)
- "array-curry: The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive): ")
+ "The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive)")
(test (array-curry (make-array (make-interval '#(0 0) '#(1 1)) list) 2)
- "array-curry: The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive): ")
+ "The second argument is not an exact integer between 0 and (interval-dimension (array-domain array)) (exclusive)")
(let ((array-builders (vector (list u1-storage-class (lambda indices (random (expt 2 1))))
@@ -1941,16 +1941,16 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "specialized-array-share error tests"
(test (specialized-array-share 1 1 1)
- "specialized-array-share: The first argument is not a specialized-array: ")
+ "The first argument is not a specialized-array")
(test (specialized-array-share (make-specialized-array (make-interval '#(1) '#(2)))
1 1)
- "specialized-array-share: The second argument is not an interval: ")
+ "The second argument is not an interval")
(test (specialized-array-share (make-specialized-array (make-interval '#(1) '#(2)))
(make-interval '#(0) '#(1))
1)
- "specialized-array-share: The third argument is not a procedure: ")
+ "The third argument is not a procedure")
(test (myarray= (list->array (reverse (local-iota 0 10))
@@ -2075,15 +2075,15 @@ OTHER DEALINGS IN THE SOFTWARE.
(let ((int (make-interval '#(0 0) '#(10 10)))
(translation '#(10 -2)))
(test (interval-translate 'a 10)
- "interval-translate: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-translate int 10)
- "interval-translate: The second argument is not a vector of exact integers: ")
+ "The second argument is not a vector of exact integers")
(test (interval-translate int '#(a b))
- "interval-translate: The second argument is not a vector of exact integers: ")
+ "The second argument is not a vector of exact integers")
(test (interval-translate int '#(1. 2.))
- "interval-translate: The second argument is not a vector of exact integers: ")
+ "The second argument is not a vector of exact integers")
(test (interval-translate int '#(1))
- "interval-translate: The dimension of the first argument (an interval) does not equal the length of the second (a vector): ")
+ "The dimension of the first argument (an interval) does not equal the length of the second (a vector)")
(do ((i 0 (+ i 1)))
((= i tests))
(let* ((int (random-interval))
@@ -2121,11 +2121,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(map - args (vector->list translation)))))))
(test (array-translate 'a 1)
- "array-translate: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-translate immutable-array '#(1.))
- "array-translate: The second argument is not a vector of exact integers: ")
+ "The second argument is not a vector of exact integers")
(test (array-translate immutable-array '#(0 2 3))
- "array-translate: The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector): ")
+ "The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector)")
(let ((specialized-result (array-translate specialized-array translation)))
(test (specialized-array? specialized-result)
#t))
@@ -2179,10 +2179,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(A (array-translate mutable '#(0 0 0 0 0))))
(test ((array-getter A) 0 0)
- "The number of indices does not equal the array dimension: ")
+ "The number of indices does not equal the array dimension")
(test ((array-setter A) 'a 0 0)
- "The number of indices does not equal the array dimension: ")))
+ "The number of indices does not equal the array dimension")))
(test-group "interval and array permutation tests"
@@ -2190,17 +2190,17 @@ OTHER DEALINGS IN THE SOFTWARE.
(let ((int (make-interval '#(0 0) '#(10 10)))
(permutation '#(1 0)))
(test (interval-permute 'a 10)
- "interval-permute: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-permute int 10)
- "interval-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (interval-permute int '#(a b))
- "interval-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (interval-permute int '#(1. 2.))
- "interval-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (interval-permute int '#(10 -2))
- "interval-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (interval-permute int '#(0))
- "interval-permute: The dimension of the first argument (an interval) does not equal the length of the second (a permutation): ")
+ "The dimension of the first argument (an interval) does not equal the length of the second (a permutation)")
(do ((i 0 (+ i 1)))
((= i tests))
(let* ((int (random-interval))
@@ -2222,13 +2222,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(permutation '#(1 0)))
(test (array-permute 'a 1)
- "array-permute: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-permute immutable-array '#(1.))
- "array-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (array-permute immutable-array '#(2))
- "array-permute: The second argument is not a permutation: ")
+ "The second argument is not a permutation")
(test (array-permute immutable-array '#(0 1 2))
- "array-permute: The dimension of the first argument (an array) does not equal the dimension of the second argument (a permutation): ")
+ "The dimension of the first argument (an array) does not equal the dimension of the second argument (a permutation)")
(let ((specialized-result (array-permute specialized-array permutation)))
(test (specialized-array? specialized-result)
#t))
@@ -2366,34 +2366,34 @@ OTHER DEALINGS IN THE SOFTWARE.
;;; won't test as much
(test (array-rotate 1 1)
- "array-rotate: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-rotate (make-array (make-interval '#(0 0) '#(2 3)) list) 'a)
- "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)")
(test (array-rotate (make-array (make-interval '#(0 0) '#(2 3)) list) 1.)
- "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)")
(test (array-rotate (make-array (make-interval '#(0 0) '#(2 3)) list) 1/2)
- "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)")
(test (array-rotate (make-array (make-interval '#(0 0) '#(2 3)) list) -1)
- "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)")
(test (array-rotate (make-array (make-interval '#(0 0) '#(2 3)) list) 4)
- "array-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the array-dimension of the first argument (exclusive)")
(test (interval-rotate 1 1)
- "interval-rotate: The first argument is not an interval: ")
+ "The first argument is not an interval")
(test (interval-rotate (make-interval '#(0 0) '#(2 3)) 'a)
- "interval-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive)")
(test (interval-rotate (make-interval '#(0 0) '#(2 3)) 1.)
- "interval-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive)")
(test (interval-rotate (make-interval '#(0 0) '#(2 3)) 37)
- "interval-rotate: The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive): ")
+ "The second argument is not an exact integer betweeen 0 (inclusive) and the interval-dimension of the first argument (exclusive)")
(for-each (lambda (n)
(let* ((upper-bounds (make-vector n 2))
@@ -2450,11 +2450,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(b (make-interval '#(0) '#(10)))
(c (make-interval '#(10 10) '#(20 20))))
(test (interval-intersect 'a)
- "interval-intersect: The argument is not an interval: ")
+ "The argument is not an interval")
(test (interval-intersect a 'a)
- "interval-intersect: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(test (interval-intersect a b)
- "interval-intersect: Not all arguments have the same dimension: "))
+ "Not all arguments have the same dimension"))
(define (my-interval-intersect . args)
@@ -2498,30 +2498,30 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "test interval-scale and array-sample"
(test (interval-scale 1 'a)
- "interval-scale: The first argument is not an interval with all lower bounds zero: ")
+ "The first argument is not an interval with all lower bounds zero")
(test (interval-scale (make-interval '#(1) '#(2)) 'a)
- "interval-scale: The first argument is not an interval with all lower bounds zero: ")
+ "The first argument is not an interval with all lower bounds zero")
(test (interval-scale (make-interval '#(0) '#(1))
'a)
- "interval-scale: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (interval-scale (make-interval '#(0) '#(1))
'#(a))
- "interval-scale: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (interval-scale (make-interval '#(0) '#(1))
'#(0))
- "interval-scale: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (interval-scale (make-interval '#(0) '#(1))
'#(1.))
- "interval-scale: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (interval-scale (make-interval '#(0) '#(1))
'#(1 2))
- "interval-scale: The dimension of the first argument (an interval) is not equal to the length of the second (a vector): ")
+ "The dimension of the first argument (an interval) is not equal to the length of the second (a vector)")
(define (myinterval-scale interval scales)
(make-interval (interval-lower-bounds->vector interval)
@@ -2538,22 +2538,22 @@ OTHER DEALINGS IN THE SOFTWARE.
(myinterval-scale interval scales))))
(test (array-sample 'a 'a)
- "array-sample: The first argument is not an array whose domain has zero lower bounds: ")
+ "The first argument is not an array whose domain has zero lower bounds")
(test (array-sample (make-array (make-interval '#(1) '#(2)) list) 'a)
- "array-sample: The first argument is not an array whose domain has zero lower bounds: ")
+ "The first argument is not an array whose domain has zero lower bounds")
(test (array-sample (make-array (make-interval '#(0) '#(2)) list) 'a)
- "array-sample: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (array-sample (make-array (make-interval '#(0) '#(2)) list) '#(1.))
- "array-sample: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (array-sample (make-array (make-interval '#(0) '#(2)) list) '#(0))
- "array-sample: The second argument is not a vector of positive, exact, integers: ")
+ "The second argument is not a vector of positive, exact, integers")
(test (array-sample (make-array (make-interval '#(0) '#(2)) list) '#(2 1))
- "array-sample: The dimension of the first argument (an array) is not equal to the length of the second (a vector): ")
+ "The dimension of the first argument (an array) is not equal to the length of the second (a vector)")
(define (myarray-sample array scales)
(let ((scales-list (vector->list scales)))
@@ -2612,18 +2612,18 @@ OTHER DEALINGS IN THE SOFTWARE.
(test (array-extract (make-array (make-interval '#(0 0) '#(1 1)) list)
'a)
- "array-extract: The second argument is not an interval: ")
+ "The second argument is not an interval")
(test (array-extract 'a (make-interval '#(0 0) '#(1 1)))
- "array-extract: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-extract (make-array (make-interval '#(0 0) '#(1 1)) list)
(make-interval '#(0) '#(1)))
- "array-extract: The dimension of the second argument (an interval) does not equal the dimension of the domain of the first argument (an array): ")
+ "The dimension of the second argument (an interval) does not equal the dimension of the domain of the first argument (an array)")
(test (array-extract (make-array (make-interval '#(0 0) '#(1 1)) list)
(make-interval '#(0 0) '#(1 3)))
- "array-extract: The second argument (an interval) is not a subset of the domain of the first argument (an array): ")
+ "The second argument (an interval) is not a subset of the domain of the first argument (an array)")
(do ((i 0 (fx+ i 1)))
((fx= i tests))
(let* ((domain (random-interval))
@@ -2687,15 +2687,15 @@ OTHER DEALINGS IN THE SOFTWARE.
(test (array-tile 'a '#(10))
- "array-tile: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-tile (make-array (make-interval '#(0 0) '#(10 10)) list) 'a)
- "array-tile: The second argument is not a vector of exact positive integers: ")
+ "The second argument is not a vector of exact positive integers")
(test (array-tile (make-array (make-interval '#(0 0) '#(10 10)) list) '#(a a))
- "array-tile: The second argument is not a vector of exact positive integers: ")
+ "The second argument is not a vector of exact positive integers")
(test (array-tile (make-array (make-interval '#(0 0) '#(10 10)) list) '#(-1 1))
- "array-tile: The second argument is not a vector of exact positive integers: ")
+ "The second argument is not a vector of exact positive integers")
(test (array-tile (make-array (make-interval '#(0 0) '#(10 10)) list) '#(10))
- "array-tile: The dimension of the first argument (an array) does not equal the length of the second argument (a vector): ")
+ "The dimension of the first argument (an array) does not equal the length of the second argument (a vector)")
(do ((d 1 (fx+ d 1)))
((fx= d 6))
@@ -2703,7 +2703,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(B (array-tile A (make-vector d 10)))
(index (make-list d 12)))
(test (apply (array-getter B) index)
- "array-tile: Index to result array is not valid: ")))
+ "Index to result array is not valid")))
(define (ceiling-quotient x d)
;; assumes x and d are positive
@@ -2793,19 +2793,19 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-reverse tests"
(test (array-reverse 'a 'a)
- "array-reverse: The first argument is not an array: ")
+ "The first argument is not an array")
(test (array-reverse (make-array (make-interval '#(0 0) '#(2 2)) list)
'a)
- "array-reverse: The second argument is not a vector of booleans: ")
+ "The second argument is not a vector of booleans")
(test (array-reverse (make-array (make-interval '#(0 0) '#(2 2)) list)
'#(1 0))
- "array-reverse: The second argument is not a vector of booleans: ")
+ "The second argument is not a vector of booleans")
(test (array-reverse (make-array (make-interval '#(0 0) '#(2 2)) list)
'#(#t))
- "array-reverse: The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector of booleans): ")
+ "The dimension of the first argument (an array) does not equal the dimension of the second argument (a vector of booleans)")
(define (myarray-reverse array flip?)
@@ -2909,30 +2909,30 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "array-assign! tests"
(test (array-assign! 'a 'a)
- "array-assign!: The destination is not a mutable array: ")
+ "The destination is not a mutable array")
(test (array-assign! (make-array (make-interval '#(0 0) '#(1 1)) values) 'a)
- "array-assign!: The destination is not a mutable array: ")
+ "The destination is not a mutable array")
(test (array-assign! (array-copy (make-array (make-interval '#(0 0) '#(1 1)) values)) 'a)
- "array-assign!: The source is not an array: ")
+ "The source is not an array")
(test (array-assign! (array-copy (make-array (make-interval '#(0 0) '#(1 1)) values))
(make-array (make-interval '#(0 0) '#(2 1)) values))
;; different volume
- "array-assign!: The destination and source do not have the same number of elements: ")
+ "The destination and source do not have the same number of elements")
(test (array-assign! (make-array (make-interval '#(1 2)) list list) ;; not valid
(make-array (make-interval '#(0 0) '#(2 1)) values))
;; not a specialized-array
- "array-assign!: The destination and source do not have the same domains, and the destination is not a specialized array: ")
+ "The destination and source do not have the same domains, and the destination is not a specialized array")
(test (array-assign! (array-rotate (array-copy (make-array (make-interval '#(2 3))
list ))
1)
(make-array (make-interval '#(2 3)) list))
;; transpose the destination
- "array-assign!: The destination and source do not have the same domains, and the elements of the destination are not stored adjacently and in order: ")
+ "The destination and source do not have the same domains, and the elements of the destination are not stored adjacently and in order")
(let ((destination (make-specialized-array (make-interval '#(3 2)))) ;; elements in order
(source (array-rotate (make-array (make-interval '#(3 2)) list) ;; not the same interval, but same volume
@@ -2961,11 +2961,11 @@ OTHER DEALINGS IN THE SOFTWARE.
(make-array (array-domain safe-specialized-destination)
(lambda args 100)))) ;; not 0 or 1
(test (array-assign! unsafe-specialized-destination source) ;; should check anyway
- "array-assign!: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (array-assign! safe-specialized-destination source)
- "array-assign!: Not all elements of the source can be stored in destination: ")
+ "Not all elements of the source can be stored in destination")
(test (array-assign! mutable-destination source)
- "array-setter: value cannot be stored in body: ")))
+ "value cannot be stored in body")))
(do ((i 0 (fx+ i 1)))
((fx= i tests))
@@ -3022,10 +3022,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(test (make-array (make-interval '#(0 0) '#(10 10))
list
'a)
- "make-array: The third argument is not a procedure: ")
+ "The third argument is not a procedure")
(test (array-dimension 'a)
- "array-dimension: The argument is not an array: ")
+ "The argument is not an array")
(test (array-safe?
(array-copy (make-array (make-interval '#(0 0) '#(10 10)) list)
@@ -3078,55 +3078,55 @@ OTHER DEALINGS IN THE SOFTWARE.
(random-multi-index domain))
list)))
(test (apply setter invalid-entry valid-args)
- "array-setter: value cannot be stored in body: ")
+ "value cannot be stored in body")
(set-car! valid-args 'a)
(test (apply getter valid-args)
- "array-getter: multi-index component is not an exact integer: ")
+ "multi-index component is not an exact integer")
(test (apply setter 10 valid-args)
- "array-setter: multi-index component is not an exact integer: ")
+ "multi-index component is not an exact integer")
(set-car! valid-args 10000) ;; outside the range of any random-interval
(test (apply getter valid-args)
- "array-getter: domain does not contain multi-index: ")
+ "domain does not contain multi-index")
(test (apply setter 10 valid-args)
- "array-setter: domain does not contain multi-index: " )
+ "domain does not contain multi-index" )
(if (< 4 dimension)
(begin
(set! valid-args (cons 1 valid-args))
(test (apply getter valid-args)
- "array-getter: multi-index is not the correct dimension: ")
+ "multi-index is not the correct dimension")
(test (apply setter 10 valid-args)
- "array-setter: multi-index is not the correct dimension: ")))))))
+ "multi-index is not the correct dimension")))))))
(test-group "array->list and list->array"
(test (array->list 'a)
- "array->list: The argument is not an array: ")
+ "The argument is not an array")
(test (list->array 'a 'b)
- "list->array: The first argument is not a list: ")
+ "The first argument is not a list")
(test (list->array '(0) 'b)
- "list->array: The second argument is not an interval: ")
+ "The second argument is not an interval")
(test (list->array '(0) (make-interval '#(0) '#(1)) 'a)
- "list->array: The third argument is not a storage-class: ")
+ "The third argument is not a storage-class")
(test (list->array '(0) (make-interval '#(0) '#(1)) generic-storage-class 'a)
- "list->array: The fourth argument is not a boolean: ")
+ "The fourth argument is not a boolean")
(test (list->array '(0) (make-interval '#(0) '#(1)) generic-storage-class #t 'a)
- "list->array: The fifth argument is not a boolean: ")
+ "The fifth argument is not a boolean")
;; (list->array '(0) (make-interval '#(0) '#(10)))
(test (list->array '(0) (make-interval '#(0) '#(10)))
- "list->array: The length of the first argument does not equal the volume of the second: ")
+ "The length of the first argument does not equal the volume of the second")
(test (list->array '(a) (make-interval '#(0) '#(1)) u1-storage-class)
- "list->array: Not every element of the list can be stored in the body of the array: " )
+ "Not every element of the list can be stored in the body of the array" )
(test (list->array '(a) (make-interval '#(10)))
- "list->array: The length of the first argument does not equal the volume of the second: ")
+ "The length of the first argument does not equal the volume of the second")
(let ((array-builders (vector (list u1-storage-class (lambda indices (random 0 (expt 2 1))))
@@ -3165,10 +3165,10 @@ OTHER DEALINGS IN THE SOFTWARE.
(list->vector (apply append (map interval-upper-bounds->list args)))))
(test (interval-cartesian-product 'a)
- "interval-cartesian-product: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(test (interval-cartesian-product (make-interval '#(0) '#(1)) 'a)
- "interval-cartesian-product: Not all arguments are intervals: ")
+ "Not all arguments are intervals")
(do ((i 0 (+ i 1)))
((= i tests))
@@ -3182,13 +3182,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(let ((test-array (make-array (make-interval '#(0) '#(1)) list)))
(test (array-outer-product 'a test-array test-array)
- "array-outer-product: The first argument is not a procedure: ")
+ "The first argument is not a procedure")
(test (array-outer-product append 'a test-array)
- "array-outer-product: The second argument is not an array: ")
+ "The second argument is not an array")
(test (array-outer-product append test-array 'a)
- "array-outer-product: The third argument is not an array: "))
+ "The third argument is not an array"))
(do ((i 0 (+ i 1)))
((= i tests))
@@ -3213,7 +3213,7 @@ OTHER DEALINGS IN THE SOFTWARE.
(do ((i 1 (+ i 1)))
((= i 6))
(test (apply array-ref 1 (make-list i 0))
- "array-ref: The first argument is not an array: "))
+ "The first argument is not an array"))
(test-assert
(condition-case
@@ -3222,7 +3222,7 @@ OTHER DEALINGS IN THE SOFTWARE.
[var () #f]))
(test (array-ref A-ref 1 1001)
- "array-getter: domain does not contain multi-index: ")
+ "domain does not contain multi-index")
(test (array-ref A-ref 4 4)
1)
@@ -3237,7 +3237,7 @@ OTHER DEALINGS IN THE SOFTWARE.
u1-storage-class))
(test (array-set! 1 1 1)
- "array-set!: The first argument is not a mutable array: ")
+ "The first argument is not a mutable array")
(test-assert
(condition-case
@@ -3258,7 +3258,7 @@ OTHER DEALINGS IN THE SOFTWARE.
[var () #f]))
(test (array-set! B-set! 2 1 1)
- "array-setter: value cannot be stored in body: ")
+ "value cannot be stored in body")
(array-set! B-set! 1 1 2)
(array-set! B-set! 0 2 2)
@@ -3268,13 +3268,13 @@ OTHER DEALINGS IN THE SOFTWARE.
(test-group "specialized-array-reshape tests"
(test (specialized-array-reshape 'a 1)
- "specialized-array-reshape: The first argument is not a specialized array: ")
+ "The first argument is not a specialized array")
(test (specialized-array-reshape A-ref 'a)
- "specialized-array-reshape: The second argument is not an interval ")
+ "The second argument is not an interval")
(test (specialized-array-reshape A-ref (make-interval '#(5)))
- "specialized-array-reshape: The volume of the domain of the first argument is not equal to the volume of the second argument: ")
+ "The volume of the domain of the first argument is not equal to the volume of the second argument")
(let ((array (array-copy (make-array (make-interval '#(2 1 3 1)) list))))
(test (array->list array)
@@ -3325,22 +3325,22 @@ OTHER DEALINGS IN THE SOFTWARE.
(array->list array)))
(test (specialized-array-reshape (array-reverse (array-copy (make-array (make-interval '#(2 1 3 1)) list)) '#(#t #f #f #f)) (make-interval '#(6)))
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
(test (specialized-array-reshape (array-reverse (array-copy (make-array (make-interval '#(2 1 3 1)) list)) '#(#t #f #f #f)) (make-interval '#(3 2)))
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
(test (specialized-array-reshape (array-reverse (array-copy (make-array (make-interval '#(2 1 3 1)) list)) '#(#f #f #t #f)) (make-interval '#(6)))
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
(test (specialized-array-reshape (array-reverse (array-copy (make-array (make-interval '#(2 1 3 1)) list)) '#(#f #f #t #t)) (make-interval '#(3 2)))
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
(test (specialized-array-reshape (array-sample (array-reverse (array-copy (make-array (make-interval '#(2 1 3 1)) list)) '#(#f #f #f #t)) '#(1 1 2 1)) (make-interval '#(4)) )
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
(test (specialized-array-reshape (array-sample (array-reverse (array-copy (make-array (make-interval '#(2 1 4 1)) list)) '#(#f #f #t #t)) '#(1 1 2 1)) (make-interval '#(4)))
- "specialized-array-reshape: Requested reshaping is impossible: "))
+ "Requested reshaping is impossible"))
(test-group "Test code from the SRFI document"
@@ -3357,7 +3357,7 @@ OTHER DEALINGS IN THE SOFTWARE.
#t)
(test (interval-dilate (make-interval '#(100 100)) '#(0 0) '#(-500 -50))
- "interval-dilate: The resulting interval is empty: ")
+ "The resulting interval is empty")
(define a (make-array (make-interval '#(1 1) '#(11 11))
(lambda (i j)
@@ -4069,7 +4069,7 @@ OTHER DEALINGS IN THE SOFTWARE.
;; (array-display B)
(test (array-display (specialized-array-reshape B (make-interval '#(8))))
- "specialized-array-reshape: Requested reshaping is impossible: ")
+ "Requested reshaping is impossible")
;; (array-display (specialized-array-reshape B (make-interval '#(8)) #t))