Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-12 23:47:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

try-fitted2/output* calls output on the argument string if it's

Browse source 
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.
This commit is contained in:
Jim Rees 2018-03-22 11:06:55 -04:00
parent b947e4ef47
commit 406aacf4dd
1 changed files with 11 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
lib/chibi/show/pretty.scm
View file

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