From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 30 Jun 1987 20:39:50 +0000 (+0000)
Subject: Change handling of lists whose car is 'QUOTE so that the list
X-Git-Tag: 20090517-FFI~13313
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ebaef88c320bf2ef1f472c8f8d02c8b186c4434e;p=mit-scheme.git

Change handling of lists whose car is 'QUOTE so that the list
	(FOO QUOTE)
does not print out as
	(FOO . (QUOTE))
---

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