diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/arrays.scm | 40 | ||||
-rw-r--r-- | module/ice-9/pretty-print.scm | 24 |
2 files changed, 56 insertions, 8 deletions
diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm index 2c04b2ef8..f03eb351b 100644 --- a/module/ice-9/arrays.scm +++ b/module/ice-9/arrays.scm @@ -17,9 +17,13 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 arrays) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) #:export (array-copy)) -; This is actually defined in boot-9.scm, apparently for b.c. +;; This is actually defined in boot-9.scm, apparently for backwards +;; compatibility. + ;; (define (array-shape a) ;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) ;; (array-dimensions a))) @@ -30,3 +34,37 @@ (array-copy! a b) b)) + +;; Printing arrays + +;; The dimensions aren't printed out unless they cannot be deduced from +;; the content, which happens only when certain axes are empty. #:dims? +;; can be used to force this printing. An array with all the dimensions +;; printed out is still readable syntax, this can be useful for +;; truncated-print. + +(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?)))))))) diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm index d3d765202..f90e15d38 100644 --- a/module/ice-9/pretty-print.scm +++ b/module/ice-9/pretty-print.scm @@ -429,17 +429,25 @@ sub-expression, via the @var{breadth-first?} keyword argument." (display ")")) (else (display "#")))) + ((bitvector? x) + (cond + ((>= width (+ 2 (array-length x))) + (format #t "~a" x)) + ;; the truncated bitvector would print as #1b(...), so we print by hand. + ((>= width (+ 2 ellipsis-width)) + (format #t "#*") + (array-for-each (lambda (xi) (format #t (if xi "1" "0"))) + (make-shared-array x list (- width 2 ellipsis-width))) + (format #t ellipsis)) + (else + (display "#")))) ((and (array? x) (not (string? x))) (let* ((type (array-type x)) (prefix (if inner? "" - (if (zero? (array-rank x)) - (string-append "#0" (if (eq? #t type) "" (symbol->string type))) - (let ((s (format #f "~a" - (apply make-typed-array type *unspecified* - (make-list (array-rank x) 0))))) - (substring s 0 (- (string-length s) 2)))))) + (call-with-output-string + (lambda (s) ((@@ (ice-9 arrays) array-print-prefix) x s))))) (width-prefix (string-length prefix))) (cond ((>= width (+ 2 width-prefix ellipsis-width)) @@ -447,7 +455,9 @@ sub-expression, via the @var{breadth-first?} keyword argument." (if (zero? (array-rank x)) (print (array-ref x) (- width width-prefix 2)) (print-sequence x (- width width-prefix 2) (array-length x) - array-cell-ref identity + (let ((base (caar (array-shape x)))) + (lambda (x i) (array-cell-ref x (+ base i)))) + identity #:inner? (< 1 (array-rank x)))) (display ")")) (else |