Patch for ice-9/pretty-print.scm

* Patch for ice-9/pretty-print.scm
@ 2004-05-26 15:30 Matthias Koeppe
  2004-08-09 21:58 ` Marius Vollmer
  0 siblings, 1 reply; 2+ messages in thread
From: Matthias Koeppe @ 2004-05-26 15:30 UTC (permalink / raw)


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  <mkoeppe@mail.math.uni-magdeburg.de>

	* 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.
-
-@lisp
-(write (lambda (x) x))
-@print{}
-#<procedure #f (x)>
-
-(pretty-print (lambda (x) x))
-@print{}
-#[procedure]
-@end 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


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 2+ messages in thread