Patch for ice-9/pretty-print.scm

[Matthias Koeppe]

Here is a patch for CVS Guile that removes a restriction from the
pretty-print procedure, as well as 40 lines of code implementing the
restriction and 19 lines of its documentation.

2004-05-26  Matthias Koeppe  <address@hidden>

        * pretty-print.scm (generic-write): In the local procedure `wr', use
        object->string to 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'.

Index: ice-9/pretty-print.scm
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/ice-9/pretty-print.scm,v
retrieving revision 1.7
diff -u -p -r1.7 pretty-print.scm
--- ice-9/pretty-print.scm      5 Apr 2003 19:04:27 -0000       1.7
+++ ice-9/pretty-print.scm      26 May 2004 15:18:51 -0000
@@ -1,6 +1,6 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;;   Copyright (C) 2001 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2001, 2004 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -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)

Index: doc/ref/misc-modules.texi
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/doc/ref/misc-modules.texi,v
retrieving revision 1.10
diff -u -p -r1.10 misc-modules.texi
--- doc/ref/misc-modules.texi   21 Apr 2004 14:32:26 -0000      1.10
+++ doc/ref/misc-modules.texi   26 May 2004 15:18:51 -0000
@@ -59,25 +59,6 @@ Print within the given @var{columns}.  T
 @end table
 @end deffn

-Beware: Since @code{pretty-print} uses it's own write procedure, it's
-output will not be the same as for example the output of @code{write}.
-Consider the following example.
-
address@hidden
-(write (lambda (x) x))
address@hidden
-#<procedure #f (x)>
-
-(pretty-print (lambda (x) x))
address@hidden
-#[procedure]
address@hidden lisp
-
-The reason is that @code{pretty-print} does not know as much about
-Guile's object types as the builtin procedures.  This is particularly
-important for smobs, for which a write procedure can be defined and be
-used by @code{write}, but not by @code{pretty-print}.
-

 @page
 @node Formatted Output


-- 
Matthias Koeppe -- http://www.math.uni-magdeburg.de/~mkoeppe