From 406aacf4dd36ef42b4cb071a35d8136739849487 Mon Sep 17 00:00:00 2001
From: Jim Rees <jimreesma@gmail.com>
Date: Thu, 22 Mar 2018 11:06:55 -0400
Subject: [PATCH] try-fitted2/output* calls output on the argument string if
 it's determined the string will not exceed the column width.  But output is
 the caller environment's output state variable.  A better choice is
 output-default.

In two places (length+ form) is replaced with (or (length+ form) +inf.0)
so that arithmetic can be performed on the result.

To support cyclic structures in pretty-simply (wrapped with
trimmed/lazy), the call-with-output form in pp-with-indent needs to be
wrapped with an appropriate trimmed/lazy.

In pp-pair, call (pp (car ls)) instead of (pretty (car ls)).

In pretty-simply, don't use call-with-output, that prevents
(trimmed/lazy n (pretty-simply ...)) from working at all on cyclic
input.
---
 lib/chibi/show/pretty.scm | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/lib/chibi/show/pretty.scm b/lib/chibi/show/pretty.scm
index bfe9e734..5eda8165 100644
--- a/lib/chibi/show/pretty.scm
+++ b/lib/chibi/show/pretty.scm
@@ -63,7 +63,7 @@
                         ((> col width)
                          (abort fail))
                         (else
-                         (output str)))))))))
+                         (output-default str)))))))))
          (fn-fork
           (with ((output output*)
                  (port out))
@@ -151,7 +151,7 @@
            => cdr)
           (else #f))))
     (if (and (number? indent) (negative? indent))
-        (max 0 (- (+ (length+ form) indent) 1))
+        (max 0 (- (+ (or (length+ form) +inf.0) indent) 1))
         indent)))
 
 (define (with-reset-shares shares proc)
@@ -182,9 +182,11 @@
              ;; reset in case we don't fit on the first line
              (reset-shares (with-reset-shares shares nothing)))
          (call-with-output
-          (each " "
-                (joined/shares
-                 (lambda (x) (pp-flat x pp shares)) fixed shares " "))
+          (trimmed/lazy (- width col2)
+                        (each " "
+                              (joined/shares
+                               (lambda (x) (pp-flat x pp shares)) fixed shares " "))
+                        )
           (lambda (first-line)
             (cond
              ((< (+ col2 (string-width first-line)) width)
@@ -195,7 +197,7 @@
                       (cond
                        ((not (or (null? tail) (pair? tail)))
                         (each ". " (pp tail pp shares)))
-                       ((> (length+ (cdr ls)) (or indent-rule 1))
+                       ((> (or (length+ (cdr ls)) +inf.0) (or indent-rule 1))
                         (each sep (joined/shares pp tail shares sep)))
                        (else
                         nothing)))))
@@ -299,7 +301,7 @@
   (cond
    ;; one element list, no lines to break
    ((null? (cdr ls))
-    (each "(" (pretty (car ls)) ")"))
+    (each "(" (pp (car ls)) ")"))
    ;; quote or other abbrev
    ((and (pair? (cdr ls)) (null? (cddr ls))
          (assq (car ls) syntax-abbrevs))
@@ -362,7 +364,5 @@
 
 (define (pretty-simply obj)
   (fn ()
-    (call-with-output
-     (each (pp obj (extract-shared-objects #f #f))
-           fl)
-     displayed)))
+    (each (pp obj (extract-shared-objects #f #f))
+          fl)))