1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071 |
- (define-module (ice-9 arrays)
- #:use-module (rnrs io ports)
- #:use-module (srfi srfi-1)
- #:export (array-copy))
- (define (array-copy a)
- (let ((b (apply make-typed-array (array-type a) *unspecified* (array-shape a))))
- (array-copy! a b)
- b))
- (define* (array-print-prefix a port #:key dims?)
- (put-char port #\#)
- (display (array-rank a) port)
- (let ((t (array-type a)))
- (unless (eq? #t t)
- (display t port)))
- (let ((ss (array-shape a)))
- (let loop ((s ss) (slos? #f) (szero? #f) (slens? dims?))
- (define lo caar)
- (define hi cadar)
- (if (null? s)
- (when (or slos? slens?)
- (pair-for-each (lambda (s)
- (when slos?
- (put-char port #\@)
- (display (lo s) port))
- (when slens?
- (put-char port #\:)
- (display (- (hi s) (lo s) -1) port)))
- ss))
- (let ((zero-size? (zero? (- (hi s) (lo s) -1))))
- (loop (cdr s)
- (or slos? (not (zero? (lo s))))
- (or szero? zero-size?)
- (or slens? (and (not zero-size?) szero?))))))))
|