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