(print (ref x i)
                                (if breadth-first?
                                    (max 1
                                         (1- (floor (/ width (- len i)))))
                                    (- width (+ 1 ellipsis-width)))
                                #:inner? inner?)))))
            (display str)
            (lp (next x) (- width 1 (string-length str)) (1+ i)))))))

    (define (print-tree x width)
      ;; width is >= the width of # . #, which is 5
      (let lp ((x x)
               (width width))
        (cond
         ((or (not (pair? x)) (<= width 4))
          (display ". ")
          (print x (- width 2)))
         (else
          ;; width >= 5
          (let ((str (with-output-to-string
                       (lambda ()
                         (print (car x)
                                (if breadth-first?
                                    (floor (/ (- width 3) 2))
                                    (- width 4)))))))
            (display str)
            (display " ")
            (lp (cdr x) (- width 1 (string-length str))))))))

    (define (truncate-string str width)
      (unless (< width (string-length str))
        (error "precondition failed"))
      (or (or-map (match-lambda
                    ((prefix . suffix)
                     (and (string-prefix? prefix str)
                          (<= (+ (string-length prefix)
                                 (string-length suffix)
                                 ellipsis-width)
                              width)
                          (format #f "~a~a~a"
                                  (substring str 0
                                             (- width (string-length suffix)
                                                ellipsis-width))
                                  ellipsis
                                  suffix))))
                  '(("#<" . ">")
                    ("#(" . ")")
                    ("(" . ")")
                    ("\"" . "\"")))
          "#"))

    (define* (print x width #:key inner?)
      (cond
       ((<= width 0)
        (error "expected a positive width" width))
       ((list? x)
        (cond
         ((>= width (+ 2 ellipsis-width))
          (display "(")
          (print-sequence x (- width 2) (length x)
                          (lambda (x i) (car x)) cdr)
          (display ")"))
         (else
          (display "#"))))
       ((vector? x)
        (cond
         ((>= width (+ 3 ellipsis-width))
          (display "#(")
          (print-sequence x (- width 3) (vector-length x)
                          vector-ref identity)
          (display ")"))
         (else
          (display "#"))))
       ((bytevector? x)
        (cond
         ((>= width 9)
          (format #t  "#~a(" (array-type x))
          (print-sequence x (- width 6) (array-length x)
                          array-ref identity)
          (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) (display (if xi "1" "0")))
                          (make-shared-array x list (- width 2 ellipsis-width)))
          (display ellipsis))
         (else
          (display "#"))))
       ((and (array? x) (not (string? x)))
        (let* ((type (array-type x))
               (prefix
                (if inner?
                  ""
                  (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))
            (format #t  "~a(" prefix)
            (if (zero? (array-rank x))
              (print (array-ref x) (- width width-prefix 2))
              (print-sequence x (- width width-prefix 2) (array-length x)
                              (let ((base (caar (array-shape x))))
                                (lambda (x i) (array-cell-ref x (+ base i))))
                              identity
                              #:inner? (< 1 (array-rank x))))
            (display ")"))
           (else
            (display "#")))))
       ((pair? x)
        (cond
         ((>= width (+ 4 ellipsis-width))
          (display "(")
          (print-tree x (- width 2))
          (display ")"))
         (else
          (display "#"))))
       (else
        (call-with-truncating-output-string
         (lambda (port)
           (if display? (display x port) (write x port)))
         (lambda (full-str)
           (display full-str))
         (lambda (partial-str)
           (display (truncate-string partial-str width)))
         #:max-column width
         #:allow-newline? #f))))

    (with-output-to-port port
      (lambda ()
        (print x width)))))