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 (file)
--- 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)))
 \f
 ;;;; 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)))
 \f
 ;;;; 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))
 \f
 ;;;; 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"