X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=97dc74e1ee5a0f6c7893802fb431c0568032cf62;hb=9fd95117be995b9e15a19aa182fafe4a489a4ac7;hp=455969729b2bb476bf0917712c52084f466eea68;hpb=3b6e07c0fcb050fa86c7c42db33f49107e3097e6;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 4559697..97dc74e 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -58,10 +58,6 @@
                   (error "Class is not a structure class: ~S" ',name))
                 ,layout))))))
 
-;;; Get layout right away.
-(sb!xc:defmacro compile-time-find-layout (name)
-  (find-layout name))
-
 ;;; re. %DELAYED-GET-COMPILER-LAYOUT and COMPILE-TIME-FIND-LAYOUT, above..
 ;;;
 ;;; FIXME: Perhaps both should be defined with DEFMACRO-MUNDANELY?
@@ -479,7 +475,8 @@
           (let ((inherited (accessor-inherited-data name defstruct)))
             (cond
               ((not inherited)
-               (stuff `(declaim (inline ,name (setf ,name))))
+               (stuff `(declaim (inline ,name ,@(unless (dsd-read-only slot)
+                                                        `((setf ,name))))))
                ;; FIXME: The arguments in the next two DEFUNs should
                ;; be gensyms. (Otherwise e.g. if NEW-VALUE happened to
                ;; be the name of a special variable, things could get
@@ -971,14 +968,15 @@
            (when (and (classoid-subclasses classoid)
                       (not (eq layout old-layout)))
              (collect ((subs))
-                      (dohash (classoid layout (classoid-subclasses classoid))
-                        (declare (ignore layout))
-                        (undefine-structure classoid)
-                        (subs (classoid-proper-name classoid)))
-                      (when (subs)
-                        (warn "removing old subclasses of ~S:~%  ~S"
-                              (classoid-name classoid)
-                              (subs))))))
+               (dohash ((classoid layout) (classoid-subclasses classoid)
+                        :locked t)
+                 (declare (ignore layout))
+                 (undefine-structure classoid)
+                 (subs (classoid-proper-name classoid)))
+               (when (subs)
+                 (warn "removing old subclasses of ~S:~%  ~S"
+                       (classoid-name classoid)
+                       (subs))))))
           (t
            (unless (eq (classoid-layout classoid) layout)
              (register-layout layout :invalidate nil))
@@ -1034,6 +1032,7 @@
       (let* ((accessor-name (dsd-accessor-name dsd))
              (dsd-type (dsd-type dsd)))
         (when accessor-name
+          (setf (info :function :structure-accessor accessor-name) dd)
           (let ((inherited (accessor-inherited-data accessor-name dd)))
             (cond
               ((not inherited)