X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-defstruct.lisp;h=33dc00d359210c34b90d164375e78e22af8b05f8;hb=35697e2c02e7b29f7953ae318d50305561927a16;hp=4138741cccdf0f97b15b59e18c6f2e884e5d9feb;hpb=f409f90c5e8c4c87ed9fa6efdc0e5c1952d94602;p=sbcl.git

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 4138741..33dc00d 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -395,8 +395,8 @@
       (when raw-index
 	(let* ((data (%instance-ref structure raw-index))
 	       (raw-len (length data))
-	       (new (make-array raw-len :element-type '(unsigned-byte 32))))
-	  (declare (type (simple-array (unsigned-byte 32) (*)) data))
+	       (new (make-array raw-len :element-type 'sb!vm::word)))
+	  (declare (type (simple-array sb!vm::word (*)) data))
 	  (setf (%instance-ref res raw-index) new)
 	  (dotimes (i raw-len)
 	    (setf (aref new i) (aref data i))))))
@@ -418,6 +418,15 @@
 	(write-char #\space stream)
 	(write-string "(no LAYOUT-INFO)"))
       (return-from %default-structure-pretty-print nil))
+    ;; the structure type doesn't count as a component for
+    ;; *PRINT-LEVEL* processing.  We can likewise elide the logical
+    ;; block processing, since all we have to print is the type name.
+    ;; -- CSR, 2004-10-05
+    (when (and dd (null (dd-slots dd)))
+      (write-string "#S(" stream)
+      (prin1 name stream)
+      (write-char #\) stream)
+      (return-from %default-structure-pretty-print nil))
     (pprint-logical-block (stream nil :prefix "#S(" :suffix ")")
       (prin1 name stream)
       (let ((remaining-slots (dd-slots dd)))
@@ -444,6 +453,11 @@
   (let* ((layout (%instance-layout structure))
 	 (name (classoid-name (layout-classoid layout)))
 	 (dd (layout-info layout)))
+    (when (and dd (null (dd-slots dd)))
+      (write-string "#S(" stream)
+      (prin1 name stream)
+      (write-char #\) stream)
+      (return-from %default-structure-ugly-print nil))
     (descend-into (stream)
       (write-string "#S(" stream)
       (prin1 name stream)