mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

(generic-write): In the local procedure `wr', use object->string to

Browse source 
print all data (except for the reader macros), rather than
implementing an own printer.  The user-visible difference is that
procedures and control characters like #\tab are now printed in the
same way as by `write'.
This commit is contained in:
Marius Vollmer 2004-08-09 21:56:00 +00:00
parent 636d4be535
commit 2d51a8a165
1 changed files with 6 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

53
ice-9/pretty-print.scm
View file

@ -53,53 +53,12 @@
(and col (output str) (+ col (string-length str))))
(define (wr obj col)
(define (wr-expr expr col)
(if (read-macro? expr)
(wr (read-macro-body expr) (out (read-macro-prefix expr) col))
(wr-lst expr col)))
(define (wr-lst l col)
(if (pair? l)
(let loop ((l (cdr l))
(col (and col (wr (car l) (out "(" col)))))
(cond ((not col) col)
((pair? l)
(loop (cdr l) (wr (car l) (out " " col))))
((null? l) (out ")" col))
(else (out ")" (wr l (out " . " col))))))
(out "()" col)))
(cond ((pair? obj) (wr-expr obj col))
((null? obj) (wr-lst obj col))
((vector? obj) (wr-lst (vector->list obj) (out "#" col)))
((boolean? obj) (out (if obj "#t" "#f") col))
((number? obj) (out (number->string obj) col))
((symbol? obj) (out (symbol->string obj) col))
((procedure? obj) (out "#[procedure]" col))
((string? obj) (if display?
(out obj col)
(let loop ((i 0) (j 0) (col (out "\"" col)))
(if (and col (< j (string-length obj)))
(let ((c (string-ref obj j)))
(if (or (char=? c #\\)
(char=? c #\"))
(loop j
(+ j 1)
(out "\\"
(out (substring obj i j)
col)))
(loop i (+ j 1) col)))
(out "\""
(out (substring obj i j) col))))))
((char? obj) (if display?
(out (make-string 1 obj) col)
(out (case obj
((#\space) "space")
((#\newline) "newline")
(else (make-string 1 obj)))
(out "#\\" col))))
(else (out (object->string obj) col))))
(cond ((and (pair? obj)
(read-macro? obj))
(wr (read-macro-body obj)
(out (read-macro-prefix obj) col)))
(else
(out (object->string obj (if display? display write)) col))))
(define (pp obj col)