Add new objects to set of things that do not print. Change

`unparse-object' (in `unparser-package') to require its third
argument.

diff --git a/v7/src/runtime/format.scm b/v7/src/runtime/format.scm
index 42536804fd24c280e4d13e3e2e938041c1d2b28e..60f147e32b1cb9f5a3de614daaf765f1179eaf5d 100644 (file)
--- a/v7/src/runtime/format.scm
+++ b/v7/src/runtime/format.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/format.scm,v 13.42 1987/03/17 18:49:48 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/format.scm,v 13.43 1987/06/17 20:10:38 cph Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -52,28 +52,28 @@
 ;;;; Top Level
 
 (set! format
-(named-lambda (format port-or-string . arguments)
-  (cond ((null? port-or-string)
-        (if (and (not (null? arguments))
-                 (string? (car arguments)))
-            (with-output-to-string
-             (lambda ()
-               (format-start (car arguments) (cdr arguments))))
-            (error "Missing format string" 'FORMAT)))
-       ((string? port-or-string)
-        (format-start port-or-string arguments)
-        *the-non-printing-object*)
-       ((output-port? port-or-string)
-        (if (and (not (null? arguments))
-                 (string? (car arguments)))
-            (begin (with-output-to-port port-or-string
-                     (lambda ()
-                       (format-start (car arguments) (cdr arguments))))
-                   *the-non-printing-object*)
-            (error "Missing format string" 'FORMAT)))
-       (else
-        (error "Unrecognizable first argument" 'FORMAT
-               port-or-string)))))
+  (named-lambda (format port-or-string . arguments)
+    (cond ((null? port-or-string)
+          (if (and (not (null? arguments))
+                   (string? (car arguments)))
+              (with-output-to-string
+               (lambda ()
+                 (format-start (car arguments) (cdr arguments))))
+              (error "Missing format string" 'FORMAT)))
+         ((string? port-or-string)
+          (format-start port-or-string arguments)
+          *the-non-printing-object*)
+         ((output-port? port-or-string)
+          (if (and (not (null? arguments))
+                   (string? (car arguments)))
+              (begin (with-output-to-port port-or-string
+                       (lambda ()
+                         (format-start (car arguments) (cdr arguments))))
+                     *the-non-printing-object*)
+              (error "Missing format string" 'FORMAT)))
+         (else
+          (error "Unrecognizable first argument" 'FORMAT
+                 port-or-string)))))
 
 (define (format-start string arguments)
   (format-loop string arguments)
@@ -91,7 +91,7 @@
 
 (define (*unparse-object object)
   (declare (integrate object))
-  ((access unparse-object unparser-package) object *current-output-port*))
+  ((access unparse-object unparser-package) object *current-output-port* true))
 \f
 (define (format-loop string arguments)
   (let ((index (string-find-next-char string #\~)))

diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm
index d9e27dc670f134a708167ce15b6a9b701047ba1b..f1b945e332124352d7797c00ae9d6c33662268b3 100644 (file)
--- a/v7/src/runtime/output.scm
+++ b/v7/src/runtime/output.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 13.43 1987/04/25 09:44:31 jinx Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 13.44 1987/06/17 20:11:29 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -273,13 +273,6 @@
 \f
 ;;;; Output Procedures
 
-(define (non-printing-object? object)
-  (and (not (future? object))
-       (eq? object *the-non-printing-object*)))
-
-(define (unparse-with-brackets thunk)
-  ((access unparse-with-brackets unparser-package) thunk))
-
 (define (newline #!optional port)
   (cond ((unassigned? port) (set! port *current-output-port*))
        ((not (output-port? port)) (error "Bad output port" port)))
@@ -301,32 +294,47 @@
   ((access :flush-output port))
   *the-non-printing-object*)
 
-(define (make-unparser handler)
-  (lambda (object #!optional port)
-    (if (not (non-printing-object? object))
-       (if (unassigned? port)
-           (handler object *current-output-port*)
-           (with-output-to-port port (lambda () (handler object port)))))
-    *the-non-printing-object*))
-          
-(define display
-  (make-unparser
-   (lambda (object port)
-     (if (and (not (future? object)) (string? object))
-        ((access :write-string port) object)
-        ((access unparse-object unparser-package) object port false))
-     ((access :flush-output port)))))
-
-(define write
-  (make-unparser
-   (lambda (object port)
-     ((access unparse-object unparser-package) object port)
-     ((access :flush-output port)))))
-
-(define write-line
-  (make-unparser
-   (lambda (object port)
-      ((access :write-char port) char:newline)
-      ((access unparse-object unparser-package) object port)
-      ((access :flush-output port)))))
+(define (unparse-with-brackets thunk)
+  ((access unparse-with-brackets unparser-package) thunk))
+\f
+(define non-printing-object?
+  (let ((objects
+        (list *the-non-printing-object*
+              undefined-conditional-branch
+              (vector-ref (get-fixed-objects-vector)
+                          (fixed-objects-vector-slot 'NON-OBJECT)))))
+    (named-lambda (non-printing-object? object)
+      (and (not (future? object))
+          (memq object objects)))))
+
+(define display)
+(define write)
+(define write-line)
+
+(let ((make-unparser
+       (lambda (handler)
+        (lambda (object #!optional port)
+          (if (not (non-printing-object? object))
+              (begin (if (unassigned? port)
+                         (handler object *current-output-port*)
+                         (with-output-to-port port
+                           (lambda ()
+                             (handler object port))))
+                     ((access :flush-output port))))
+          *the-non-printing-object*))))
+  (set! display
+    (make-unparser
+     (lambda (object port)
+       (if (and (not (future? object))
+               (string? object))
+          ((access :write-string port) object)
+          ((access unparse-object unparser-package) object port false)))))
+  (set! write
+    (make-unparser
+     (lambda (object port)
+       ((access unparse-object unparser-package) object port true))))
+  (set! write-line
+    (make-unparser
+     (lambda (object port)
+       ((access :write-char port) char:newline)
        ((access :flush-output port))))))
\ No newline at end of file

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 61c6754280c1dd50ccf35c64b62d252d2db9277f..2646d441a6a15b8a2f3dfb8ba4ed58f855c9e9fd 100644 (file)
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 13.46 1987/06/15 23:42:12 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 13.47 1987/06/17 20:09:58 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -60,8 +60,7 @@
   (thunk)
   (*unparse-char #\]))
 
-(define (unparse-object object port #!optional slashify)
-  (if (unassigned? slashify) (set! slashify true))
+(define (unparse-object object port slashify)
   (fluid-let ((*unparse-char (access :write-char port))
              (*unparse-string (access :write-string port))
              (*unparser-list-depth* 0)
@@ -331,5 +330,4 @@
 (define-type 'COMPLEX unparse-number)
 
 ;;; end UNPARSER-PACKAGE.
-))
 ))
\ No newline at end of file