From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 20 May 2003 10:49:26 +0000 (+0000)
Subject: 0.8alpha.0.41:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8af1983e6de2609fec800b6ac2bf3b12ff9c68b9;p=sbcl.git

0.8alpha.0.41:
	Firefighting the build, part II
	... remove DSD-%NAME optimization, in the interest of making
		SLOT-VALUE (and hence MAKE-LOAD-FORM-SAVING-SLOTS)
		a more reliable operation.
	... now the name of the slot is the symbol in the DEFSTRUCT
		form, as expected; also, now the CL package is pristine,
		containing only the 978 exported symbols.
	Essentially this version has built from CMUCL and built itself
	successfully.
---

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 89a4edc..5619051 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -174,8 +174,8 @@
 	     (:conc-name dsd-)
 	     (:copier nil)
 	     #-sb-xc-host (:pure t))
-  ;; string name of slot
-  %name
+  ;; name of slot
+  name
   ;; its position in the implementation sequence
   (index (missing-arg) :type fixnum)
   ;; the name of the accessor function
@@ -204,17 +204,6 @@
 (def!method print-object ((x defstruct-slot-description) stream)
   (print-unreadable-object (x stream :type t)
     (prin1 (dsd-name x) stream)))
-
-;;; Return the name of a defstruct slot as a symbol. We store it as a
-;;; string to avoid creating lots of worthless symbols at load time.
-;;;
-;;; FIXME: This has horrible package issues.  In many ways, it would
-;;; be very nice to treat the names of structure slots as strings, but
-;;; unfortunately PCL requires slot names to be interned symbols.
-;;; Maybe we want to resurrect something like the old
-;;; SB-SLOT-ACCESSOR-NAME package?
-(defun dsd-name (dsd)
-  (intern (dsd-%name dsd)))
 
 ;;;; typed (non-class) structures
 
@@ -482,7 +471,7 @@
 	      ((not (= (cdr inherited) index))
 	       (style-warn "~@<Non-overwritten accessor ~S does not access ~
                             slot with name ~S (accessing an inherited slot ~
-                            instead).~:@>" name (dsd-%name slot))))))))
+                            instead).~:@>" name (dsd-name slot))))))))
     (stuff)))
 
 ;;;; parsing
@@ -611,7 +600,7 @@
 ;;; that we modify to get the new slot. This is supplied when handling
 ;;; included slots.
 (defun parse-1-dsd (defstruct spec &optional
-		    (slot (make-defstruct-slot-description :%name ""
+		    (slot (make-defstruct-slot-description :name ""
 							   :index 0
 							   :type t)))
   (multiple-value-bind (name default default-p type type-p read-only ro-p)
@@ -633,11 +622,13 @@
 		      spec))
 	spec))
 
-    (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
+    (when (find name (dd-slots defstruct)
+		:test #'string=
+		:key (lambda (x) (symbol-name (dsd-name x))))
       (error 'simple-program-error
 	     :format-control "duplicate slot name ~S"
 	     :format-arguments (list name)))
-    (setf (dsd-%name slot) (string name))
+    (setf (dsd-name slot) name)
     (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list slot)))
 
     (let ((accessor-name (if (dd-conc-name defstruct)
@@ -1035,7 +1026,7 @@
                             slot with name ~S (accessing an inherited slot ~
                             instead).~:@>"
 			   accessor-name
-			   (dsd-%name dsd)))))))))
+			   (dsd-name dsd)))))))))
   (values))
 
 ;;;; redefinition stuff
@@ -1501,7 +1492,7 @@
 			 (index 1))
 		     (dolist (slot-name slot-names)
 		       (push (make-defstruct-slot-description
-			      :%name (symbol-name slot-name)
+			      :name slot-name
 			      :index index
 			      :accessor-name (symbolicate conc-name slot-name))
 			     reversed-result)
@@ -1591,7 +1582,8 @@
 	   (let ((,object-gensym ,raw-maker-form))
 	     ,@(mapcar (lambda (slot-name)
 			 (let ((dsd (find (symbol-name slot-name) dd-slots
-					  :key #'dsd-%name
+					  :key (lambda (x)
+						 (symbol-name (dsd-name x)))
 					  :test #'string=)))
 			   ;; KLUDGE: bug 117 bogowarning.  Neither
 			   ;; DECLAREing the type nor TRULY-THE cut
diff --git a/src/code/inspect.lisp b/src/code/inspect.lisp
index 90025b5..5625d64 100644
--- a/src/code/inspect.lisp
+++ b/src/code/inspect.lisp
@@ -172,7 +172,7 @@ evaluated expressions.
         (info (layout-info (sb-kernel:layout-of object))))
     (when (sb-kernel::defstruct-description-p info)
       (dolist (dd-slot (dd-slots info) (nreverse parts-list))
-        (push (cons (dsd-%name dd-slot)
+        (push (cons (dsd-name dd-slot)
                     (funcall (dsd-accessor-name dd-slot) object))
               parts-list)))))
 
diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index c463637..bad8d95 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -422,7 +422,7 @@
 	   (pprint-pop)
 	   (let ((slot (pop remaining-slots)))
 	     (write-char #\: stream)
-	     (output-symbol-name (dsd-%name slot) stream)
+	     (output-symbol-name (symbol-name (dsd-name slot)) stream)
 	     (write-char #\space stream)
 	     (pprint-newline :miser stream)
 	     (output-object (funcall (fdefinition (dsd-accessor-name slot))
@@ -452,7 +452,7 @@
 	(write-char #\space stream)
 	(write-char #\: stream)
 	(let ((slot (first remaining-slots)))
-	  (output-symbol-name (dsd-%name slot) stream)
+	  (output-symbol-name (symbol-name (dsd-name slot)) stream)
 	  (write-char #\space stream)
 	  (output-object
 	   (funcall (fdefinition (dsd-accessor-name slot))
diff --git a/version.lisp-expr b/version.lisp-expr
index c86943d..499bd91 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8alpha.0.40"
+"0.8alpha.0.41"