Skip to content
Snippets Groups Projects
Commit 7521bbac authored by ram's avatar ram
Browse files

In PARSE-1-DSD, don't blow away the accessor when we are just redefining the

same structure.  For shadowing to be a problem, the accessor must be of a
supertype.  In DSD-NAME, intern the symbol in *PACKAGE* if the accessor is NIL.
In DEFAULT-STRUCTURE-PRINT, directly use DSD-%NAME, rather than messing around
creating a symbol.
parent 0c30b890
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.31 1992/03/13 17:58:29 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.32 1992/03/14 12:05:03 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -65,7 +65,10 @@ ...@@ -65,7 +65,10 @@
;;; as a string to avoid creating lots of worthless symbols at load time. ;;; as a string to avoid creating lots of worthless symbols at load time.
;;; ;;;
(defun dsd-name (dsd) (defun dsd-name (dsd)
(intern (string (dsd-%name dsd)) (symbol-package (dsd-accessor dsd)))) (intern (string (dsd-%name dsd))
(if (dsd-accessor dsd)
(symbol-package (dsd-accessor dsd))
*package*)))
(defun print-defstruct-slot-description (structure stream depth) (defun print-defstruct-slot-description (structure stream depth)
(declare (ignore depth)) (declare (ignore depth))
...@@ -263,8 +266,7 @@ ...@@ -263,8 +266,7 @@
(string= (dsd-name (find aname (dd-slots existing) (string= (dsd-name (find aname (dd-slots existing)
:key #'dsd-accessor)) :key #'dsd-accessor))
name) name)
(member (dd-name existing) (member (dd-name existing) (dd-includes defstruct)))
(cons (dd-name defstruct) (dd-includes defstruct))))
(setf (dsd-accessor islot) nil) (setf (dsd-accessor islot) nil)
(setf (dsd-accessor islot) aname))) (setf (dsd-accessor islot) aname)))
...@@ -688,7 +690,7 @@ ...@@ -688,7 +690,7 @@
(loop (loop
(pprint-pop) (pprint-pop)
(let ((slot (pop slots))) (let ((slot (pop slots)))
(output-object (dsd-name slot) stream) (princ (dsd-%name slot) stream)
(write-char #\space stream) (write-char #\space stream)
(pprint-newline :miser stream) (pprint-newline :miser stream)
(output-object (structure-ref structure (dsd-index slot)) (output-object (structure-ref structure (dsd-index slot))
...@@ -711,7 +713,7 @@ ...@@ -711,7 +713,7 @@
(write-string "...)" stream))) (write-string "...)" stream)))
(declare (type index index)) (declare (type index index))
(write-char #\space stream) (write-char #\space stream)
(output-object (dsd-name (car slots)) stream) (princ (dsd-%name (car slots)) stream)
(write-char #\space stream) (write-char #\space stream)
(output-object (structure-ref structure index) stream)))))) (output-object (structure-ref structure index) stream))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment