From ebaef88c320bf2ef1f472c8f8d02c8b186c4434e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 30 Jun 1987 20:39:50 +0000
Subject: [PATCH] Change handling of lists whose car is 'QUOTE so that the list
 	(FOO QUOTE) does not print out as 	(FOO . (QUOTE))

---
 v7/src/runtime/unpars.scm | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 298926d61..390575b55 100644
--- 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.49 1987/06/25 22:27:53 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 13.50 1987/06/30 20:39:50 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -249,6 +249,10 @@
 	((unassigned-object? object) unparse-unassigned)
 	((unbound-object? object) unparse-unbound)
 	((reference-trap? object) unparse-reference-trap)
+	((eq? (car object) 'QUOTE)
+	 (and (pair? (cdr object))
+	      (null? (cddr object))
+	      unparse-quote-form))
 	(else
 	 (let ((entry (assq (car object) *unparser-special-pairs*)))
 	   (and entry
@@ -262,13 +266,9 @@
 	      *unparser-special-pairs*))
   *the-non-printing-object*)
 
-(add-unparser-special-pair! 'QUOTE
-  (lambda (pair)
-    (if (and (pair? (cdr pair))
-	     (null? (cddr pair)))
-	(begin (*unparse-char #\')
-	       (*unparse-object-or-future (cadr pair)))
-	(unparse-list pair))))
+(define (unparse-quote-form pair)
+  (*unparse-char #\')
+  (*unparse-object-or-future (cadr pair)))
 
 (define (unparse-unassigned x)
   (unparse-with-brackets
-- 
2.25.1