Import Debian changes 3a1-4.2debian/3a1-4.2

slib (3a1-4.2) unstable; urgency=low

  * Non-maintainer upload.
  * Add guile.init.local for use within the build dir, since otherwise we
    have an (earlier unnoticed) circular build-dep due to a difference
    between scm and guile.

slib (3a1-4.1) unstable; urgency=low

  * Non-maintainer upload.
  * Build-depend on guile-1.6 instead of scm, since the new version of
    scm is wedged in unstable (closes: #281809).

slib (3a1-4) unstable; urgency=low

  * Also check for expected creation on slibcat. (Closes: #240096)

slib (3a1-3) unstable; urgency=low

  * Also check for /usr/share/guile/1.6/slib before installing for guile
    1.6. (Closes: #239267)

slib (3a1-2) unstable; urgency=low

  * Add format.scm back into slib until gnucash stops using it.
  * Call guile-1.6 new-catalog (Closes: #238231)

slib (3a1-1) unstable; urgency=low

  * New upstream release
  * Remove Info section from doc-base file (Closes: #186950)
  * Remove period from end of description (linda, lintian)
  * html gen fixed upstream (Closes: #111778)

slib (2d4-2) unstable; urgency=low

  * Fix url for upstream source (Closes: #144981)
  * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
  * Add build depends.

slib (2d4-1) unstable; urgency=low

  * New upstream.

slib (2d3-1) unstable; urgency=low

  * New upstream.
  * Remove texi2html call in debian/rules.  Now done upstream.  Add make
    html instead.
  * Changes to rules and doc-base to conform to upstream html gen
  * Clean up upstream makefile to make sure it cleans up after itself.

1 files changed, 150 insertions, 36 deletions

diff --git a/array.scm b/array.scm
index 47df853..417e137 100644
--- a/array.scm
+++ b/array.scm
@@ -1,5 +1,5 @@
 ;;;;"array.scm" Arrays for Scheme
-; Copyright (C) 2001 Aubrey Jaffer
+; Copyright (C) 2001, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -30,7 +30,12 @@
 		      store		;data
 		      )))
 
-(define array:shape (record-accessor array:rtd 'shape))
+(define array:shape
+  (let ((shape (record-accessor array:rtd 'shape)))
+    (lambda (array)
+      (cond ((vector? array) (list (list 0 (+ -1 (vector-length array)))))
+	    ((string? array) (list (list 0 (+ -1 (string-length array)))))
+	    (else (shape array))))))
 
 (define array:scales
   (let ((scales (record-accessor array:rtd 'scales)))
@@ -77,7 +82,8 @@
 ;;corresponding elements of @1 and @2 are @code{equal?}.
 ;;
 ;;@example
-;;(array=? (make-array 'foo 3 3) (make-array 'foo '(0 2) '(1 2)))
+;;(array=? (create-array '#(foo) 3 3)
+;;         (create-array '#(foo) '(0 2) '(0 2)))
 ;;  @result{} #t
 ;;@end example
 (define (array=? array1 array2)
@@ -87,17 +93,133 @@
 (define (array:dimensions->shape dims)
   (map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dims))
 
-;;@args initial-value bound1 bound2 @dots{}
-;;Creates and returns an array with dimensions @var{bound1},
-;;@var{bound2}, @dots{} and filled with @1.
-(define (make-array initial-value . dimensions)
+;;@args prototype bound1 bound2 @dots{}
+;;
+;;Creates and returns an array of type @1 with dimensions @2, @3,
+;;@dots{} and filled with elements from @1.  @1 must be an array,
+;;vector, or string.  The implementation-dependent type of the returned
+;;array will be the same as the type of @1; except if that would be a
+;;vector or string with non-zero origin, in which case some variety of
+;;array will be returned.
+;;
+;;If the @1 has no elements, then the initial contents of the returned
+;;array are unspecified.  Otherwise, the returned array will be filled
+;;with the element at the origin of @1.
+(define (create-array prototype . dimensions)
+  (define range2length (lambda (bnd) (- 1 (apply - bnd))))
+  ;;(if (not (array? prototype)) (set! prototype (vector prototype)))
   (let* ((shape (array:dimensions->shape dimensions))
-	 (dims (map (lambda (bnd) (- 1 (apply - bnd))) shape))
-	 (scales (reverse (cons 1 (cdr (reverse dims))))))
-    (array:construct shape
-		     scales
-		     (- (apply + (map * (map car shape) scales)))
-		     (make-vector (apply * dims) initial-value))))
+	 (dims (map range2length shape))
+	 (scales
+	  (do ((dims (reverse (cdr dims)) (cdr dims))
+	       (scls '(1) (cons (* (car dims) (car scls)) scls)))
+	      ((null? dims) scls))))
+    (array:construct
+     shape
+     scales
+     (- (apply + (map * (map car shape) scales)))
+     (if (string? prototype)
+	 (case (string-length prototype)
+	   ((0) (make-string (apply * dims)))
+	   (else (make-string (apply * dims)
+			      (string-ref prototype 0))))
+	 (let ((pshape (array:shape prototype)))
+	   (case (apply * (map range2length pshape))
+	     ((0) (make-vector (apply * dims)))
+	     (else (make-vector (apply * dims)
+				(apply array-ref prototype
+				       (map car pshape))))))))))
+
+;;@noindent
+;;These functions return a prototypical uniform-array enclosing the
+;;optional argument (which must be of the correct type).  If the
+;;uniform-array type is supported by the implementation, then it is
+;;returned; defaulting to the next larger precision type; resorting
+;;finally to vector.
+
+(define (make-prototype-checker name pred? creator)
+  (lambda args
+    (case (length args)
+      ((1) (if (pred? (car args))
+	       (creator (car args))
+	       (slib:error name 'incompatible 'type (car args))))
+      ((0) (creator))
+      (else (slib:error name 'wrong 'number 'of 'args args)))))
+
+(define (integer-bytes?? n)
+  (lambda (obj)
+    (and (integer? obj)
+	 (exact? obj)
+	 (or (negative? n) (not (negative? obj)))
+	 (do ((num obj (quotient num 256))
+	      (n (+ -1 (abs n)) (+ -1 n)))
+	     ((or (zero? num) (negative? n))
+	      (zero? num))))))
+
+;;@args z
+;;@args
+;;Returns a high-precision complex uniform-array prototype.
+(define Ac64 (make-prototype-checker 'Ac64 complex? vector))
+;;@args z
+;;@args
+;;Returns a complex uniform-array prototype.
+(define Ac32 (make-prototype-checker 'Ac32 complex? vector))
+
+;;@args x
+;;@args
+;;Returns a high-precision real uniform-array prototype.
+(define Ar64 (make-prototype-checker 'Ar64 real? vector))
+;;@args x
+;;@args
+;;Returns a real uniform-array prototype.
+(define Ar32 (make-prototype-checker 'Ar32 real? vector))
+
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;64 bits of precision.
+(define As64 (make-prototype-checker 'As64 (integer-bytes?? -8) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;32 bits of precision.
+(define As32 (make-prototype-checker 'As32 (integer-bytes?? -4) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;16 bits of precision.
+(define As16 (make-prototype-checker 'As16 (integer-bytes?? -2) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;8 bits of precision.
+(define As8 (make-prototype-checker 'As8 (integer-bytes?? -1) vector))
+
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 64 bits of precision.
+(define Au64 (make-prototype-checker 'Au64 (integer-bytes?? 8) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 32 bits of precision.
+(define Au32 (make-prototype-checker 'Au32 (integer-bytes?? 4) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 16 bits of precision.
+(define Au16 (make-prototype-checker 'Au16 (integer-bytes?? 2) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 8 bits of precision.
+(define Au8 (make-prototype-checker 'Au8 (integer-bytes?? 1) vector))
+
+;;@args bool
+;;@args
+;;Returns a boolean uniform-array prototype.
+(define At1 (make-prototype-checker 'At1 boolean? vector))
 
 ;;@noindent
 ;;When constructing an array, @var{bound} is either an inclusive range of
@@ -105,18 +227,18 @@
 ;;a single integer.  So
 ;;
 ;;@example
-;;(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2))
+;;(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2))
 ;;@end example
 
 ;;@args array mapper bound1 bound2 @dots{}
-;;@code{make-shared-array} can be used to create shared subarrays of other
+;;@0 can be used to create shared subarrays of other
 ;;arrays.  The @var{mapper} is a function that translates coordinates in
 ;;the new array into coordinates in the old array.  A @var{mapper} must be
 ;;linear, and its range must stay within the bounds of the old array, but
 ;;it can be otherwise arbitrary.  A simple example:
 ;;
 ;;@example
-;;(define fred (make-array #f 8 8))
+;;(define fred (create-array '#(#f) 8 8))
 ;;(define freds-diagonal
 ;;  (make-shared-array fred (lambda (i) (list i i)) 8))
 ;;(array-set! freds-diagonal 'foo 3)
@@ -153,32 +275,28 @@
 ;;Returns the number of dimensions of @1.  If @1 is not an array, 0 is
 ;;returned.
 (define (array-rank obj)
-  (if (array? obj) (length (array-shape obj)) 0))
+  (if (array? obj) (length (array:shape obj)) 0))
 
-;;@body
+;;@args array
 ;;Returns a list of inclusive bounds.
 ;;
 ;;@example
-;;(array-shape (make-array 'foo 3 5))
+;;(array-shape (create-array '#() 3 5))
 ;;   @result{} ((0 2) (0 4))
 ;;@end example
-(define array-shape
-  (lambda (array)
-    (cond ((vector? array) (list (list 0 (+ -1 (vector-length array)))))
-	  ((string? array) (list (list 0 (+ -1 (string-length array)))))
-	  (else (array:shape array)))))
+(define array-shape array:shape)
 
 ;;@body
 ;;@code{array-dimensions} is similar to @code{array-shape} but replaces
 ;;elements with a 0 minimum with one greater than the maximum.
 ;;
 ;;@example
-;;(array-dimensions (make-array 'foo 3 5))
+;;(array-dimensions (create-array '#() 3 5))
 ;;   @result{} (3 5)
 ;;@end example
 (define (array-dimensions array)
   (map (lambda (bnd) (if (zero? (car bnd)) (+ 1 (cadr bnd)) bnd))
-       (array-shape array)))
+       (array:shape array)))
 
 (define (array:in-bounds? array indices)
   (do ((bnds (array:shape array) (cdr bnds))
@@ -217,12 +335,8 @@
 
 ;;; Legacy functions
 
-;; These procedures are fast versions of @code{array-ref} and
-;; @code{array-set!} for non-string arrays; they take a fixed number of
-;; arguments and perform no bounds checking.
-(define array-1d-ref array-ref)
-(define array-2d-ref array-ref)
-(define array-3d-ref array-ref)
-(define array-1d-set! array-set!)
-(define array-2d-set! array-set!)
-(define array-3d-set! array-set!)
+;; ;;@args initial-value bound1 bound2 @dots{}
+;; ;;Creates and returns an array with dimensions @2,
+;; ;;@3, @dots{} and filled with @1.
+;; (define (make-array initial-value . dimensions)
+;;   (apply create-array (vector initial-value) dimensions))