From 726185cfb7e4ea5f28e6f77c6fda5e2bfdfefd90 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 12 Feb 1990 10:17:02 +0000
Subject: [PATCH] Added code to set up the new INFO types TYPE
 DEFINED-STRUCTURE-INFO and TYPE PRINTER.  These get around problems with the
 printer &c thinking that the DD from compilation of a structure definition is
 the actual loaded one.

---
 code/defstruct.lisp | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 7aa7529da..60d094e40 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.lisp
@@ -68,8 +68,8 @@
 	   ;; So the print function is in the right lexical environment, and
 	   ;; can be compiled...
 	   (let ((new ',defstruct))
-	     ,@(when (consp (dd-print-function defstruct))
-		 `((setf (dd-print-function new)
+	     ,@(when (dd-print-function defstruct)
+		 `((setf (info type printer ',name)
 			 #',(dd-print-function defstruct))))
 	     (%defstruct new))
 	   ',name)
@@ -272,6 +272,8 @@
 ;;;
 (defun %defstruct (info)
   (declare (type defstruct-description info))
+  (setf (info type defined-structure-info (dd-name info)) info)
+  
   (dolist (slot (dd-slots info))
     (let ((dsd slot))
       (setf (symbol-function (dsd-accessor slot))
@@ -321,7 +323,6 @@
 		  (declare (fixnum i))
 		  (%primitive header-set res i
 			      (%primitive header-ref structure i)))))))
-
   (when (dd-doc info)
     (setf (documentation (dd-name info) 'type) (dd-doc info))))
 
@@ -547,7 +548,7 @@
   (prin1 (svref structure 0) stream)
   (do ((index 1 (1+ index))
        (length (length structure))
-       (slots (dd-slots (info type structure-info (svref structure 0)))
+       (slots (dd-slots (info type defined-structure-info (svref structure 0)))
 	      (cdr slots)))
       ((or (= index length)
 	   (and *print-length*
-- 
GitLab