X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpprint.lisp;h=0a5995101c0111425f59b8a3587db5833b3cdf24;hb=2c6b90e36a7c0377cd79625eb6c94d580f98cb93;hp=66b5d60e36f5ad800ab77ce4fe309e7c80a94560;hpb=59f7d9254f3601cfd48f0c299d5c30562111e991;p=sbcl.git

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 66b5d60..0a59951 100644
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -32,7 +32,8 @@
 				    (:out #'pretty-out)
 				    (:sout #'pretty-sout)
 				    (:misc #'pretty-misc))
-			  (:constructor make-pretty-stream (target)))
+			  (:constructor make-pretty-stream (target))
+			  (:copier nil))
   ;; Where the output is going to finally go.
   (target (required-argument) :type stream)
   ;; Line length we should format to. Cached here so we don't have to keep
@@ -97,6 +98,11 @@
   (declare (type posn posn) (type pretty-stream stream)
 	   (values posn))
   (index-column (posn-index posn stream) stream))
+
+;;; Is it OK to do pretty printing on this stream at this time?
+(defun print-pretty-on-stream-p (stream)
+  (and (pretty-stream-p stream)
+       *print-pretty*))
 
 ;;;; stream interface routines
 
@@ -147,7 +153,7 @@
 
 ;;;; logical blocks
 
-(defstruct logical-block
+(defstruct (logical-block (:copier nil))
   ;; The column this logical block started in.
   (start-column 0 :type column)
   ;; The column the current section started in.
@@ -235,13 +241,12 @@
 
 ;;;; the pending operation queue
 
-(defstruct (queued-op (:constructor nil))
+(defstruct (queued-op (:constructor nil)
+		      (:copier nil))
   (posn 0 :type posn))
 
 (defmacro enqueue (stream type &rest args)
-  (let ((constructor (intern (concatenate 'string
-					  "MAKE-"
-					  (symbol-name type)))))
+  (let ((constructor (symbolicate "MAKE-" type)))
     (once-only ((stream stream)
 		(entry `(,constructor :posn
 				      (index-posn
@@ -259,12 +264,13 @@
 	 ,entry))))
 
 (defstruct (section-start (:include queued-op)
-			  (:constructor nil))
+			  (:constructor nil)
+			  (:copier nil))
   (depth 0 :type index)
   (section-end nil :type (or null newline block-end)))
 
-(defstruct (newline
-	    (:include section-start))
+(defstruct (newline (:include section-start)
+		    (:copier nil))
   (kind (required-argument)
 	:type (member :linear :fill :miser :literal :mandatory)))
 
@@ -279,16 +285,16 @@
 	(setf (section-start-section-end entry) newline))))
   (maybe-output stream (or (eq kind :literal) (eq kind :mandatory))))
 
-(defstruct (indentation
-	    (:include queued-op))
+(defstruct (indentation (:include queued-op)
+			(:copier nil))
   (kind (required-argument) :type (member :block :current))
   (amount 0 :type fixnum))
 
 (defun enqueue-indent (stream kind amount)
   (enqueue stream indentation :kind kind :amount amount))
 
-(defstruct (block-start
-	    (:include section-start))
+(defstruct (block-start (:include section-start)
+			(:copier nil))
   (block-end nil :type (or null block-end))
   (prefix nil :type (or null simple-string))
   (suffix nil :type (or null simple-string)))
@@ -311,8 +317,8 @@
     (setf (pretty-stream-pending-blocks stream)
 	  (cons start pending-blocks))))
 
-(defstruct (block-end
-	    (:include queued-op))
+(defstruct (block-end (:include queued-op)
+		      (:copier nil))
   (suffix nil :type (or null simple-string)))
 
 (defun end-logical-block (stream)
@@ -323,8 +329,8 @@
       (pretty-sout stream suffix 0 (length suffix)))
     (setf (block-start-block-end start) end)))
 
-(defstruct (tab
-	    (:include queued-op))
+(defstruct (tab (:include queued-op)
+		(:copier nil))
   (sectionp nil :type (member t nil))
   (relativep nil :type (member t nil))
   (colnum 0 :type column)
@@ -657,7 +663,7 @@
 		  ((t) *terminal-io*)
 		  ((nil) *standard-output*)
 		  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-newline stream kind)))
   nil)
 
@@ -680,7 +686,7 @@
 		  ((t) *terminal-io*)
 		  ((nil) *standard-output*)
 		  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-indent stream relative-to n)))
   nil)
 
@@ -705,7 +711,7 @@
 		  ((t) *terminal-io*)
 		  ((nil) *standard-output*)
 		  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-tab stream kind colnum colinc)))
   nil)
 
@@ -768,7 +774,7 @@
 (defvar *initial-pprint-dispatch*)
 (defvar *building-initial-table* nil)
 
-(defstruct pprint-dispatch-entry
+(defstruct (pprint-dispatch-entry (:copier nil))
   ;; The type specifier for this entry.
   (type (required-argument) :type t)
   ;; A function to test to see whether an object is of this time. Pretty must
@@ -790,7 +796,7 @@
 	    (pprint-dispatch-entry-priority entry)
 	    (pprint-dispatch-entry-initial-p entry))))
 
-(defstruct pprint-dispatch-table
+(defstruct (pprint-dispatch-table (:copier nil))
   ;; A list of all the entries (except for CONS entries below) in highest
   ;; to lowest priority.
   (entries nil :type list)
@@ -955,7 +961,7 @@
 	     (stringp array)
 	     (bit-vector-p array))
 	 (output-ugly-object array stream))
-	((and *print-readably* (not (eq (array-element-type array) 't)))
+	((and *print-readably* (not (eq (array-element-type array) t)))
 	 (let ((*print-readably* nil))
 	   (error 'print-not-readable :object array)))
 	((vectorp array)