X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=bb0b613f20fbc6dc16bc7241f2c6a968b9189535;hb=d25e3478acccec70402ff32554669a982be8e281;hp=cc8f029a535766614829ee2f3a90999a847f4aa0;hpb=95f17ca63742f8c164309716b35bc25545a849a6;p=sbcl.git

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index cc8f029..bb0b613 100644
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -305,17 +305,23 @@
 
 ;;; The definition of STRUCTURE-TYPE-P was moved to early-low.lisp.
 
-(defun structure-type-included-type-name (type)
-  (let ((include (dd-include (find-defstruct-description type))))
-    (if (consp include)
-        (car include)
-        include)))
-
 (defun structure-type-slot-description-list (type)
-  (nthcdr (length (let ((include (structure-type-included-type-name type)))
-                    (and include
-                         (dd-slots (find-defstruct-description include)))))
-          (dd-slots (find-defstruct-description type))))
+  (let* ((dd (find-defstruct-description type))
+         (include (dd-include dd))
+         (all-slots (dd-slots dd)))
+    (multiple-value-bind (super slot-overrides)
+        (if (consp include)
+            (values (car include) (mapcar #'car (cdr include)))
+            (values include nil))
+      (let ((included-slots
+             (when super
+               (dd-slots (find-defstruct-description super)))))
+        (loop for slot = (pop all-slots)
+              for included-slot = (pop included-slots)
+              while slot
+              when (or (not included-slot)
+                       (member (dsd-name included-slot) slot-overrides :test #'eq))
+              collect slot)))))
 
 (defun structure-slotd-name (slotd)
   (dsd-name slotd))