- (eval-when (:compile-toplevel :load-toplevel :execute)
- (%compiler-set-up-layout ',dd))
-
- ;; slot readers and writers
- (declaim (inline ,@(mapcar #'dsd-accessor-name dd-slots)))
- ,@(mapcar (lambda (dsd)
- `(defun ,(dsd-accessor-name dsd) (,object-gensym)
- ,@(when runtime-type-checks-p
- `((declare (type ,class-name ,object-gensym))))
- (,raw-reffer-operator ,object-gensym
- ,(dsd-index dsd))))
- dd-slots)
- (declaim (inline ,@(mapcar (lambda (dsd)
- `(setf ,(dsd-accessor-name dsd)))
- dd-slots)))
- ,@(mapcar (lambda (dsd)
- `(defun (setf ,(dsd-accessor-name dsd)) (,new-value-gensym
- ,object-gensym)
- ,@(when runtime-type-checks-p
- `((declare (type ,class-name ,object-gensym))))
- (setf (,raw-reffer-operator ,object-gensym
- ,(dsd-index dsd))
- ,new-value-gensym)))
- dd-slots)
-
- ;; constructor
- (defun ,boa-constructor ,slot-names
- (let ((,object-gensym ,raw-maker-form))
- ,@(mapcar (lambda (slot-name)
- (let ((dsd (find (symbol-name slot-name) dd-slots
- :key (lambda (x)
- (symbol-name (dsd-name x)))
- :test #'string=)))
- ;; KLUDGE: bug 117 bogowarning. Neither
- ;; DECLAREing the type nor TRULY-THE cut
- ;; the mustard -- it still gives warnings.
- (enforce-type dsd defstruct-slot-description)
- `(setf (,(dsd-accessor-name dsd) ,object-gensym)
- ,slot-name)))
- slot-names)
- ,object-gensym))
-
- ;; predicate
- ,@(when predicate
- ;; Just delegate to the compiler's type optimization
- ;; code, which knows how to generate inline type tests
- ;; for the whole CMU CL INSTANCE menagerie.
- `(defun ,predicate (,object-gensym)
- (typep ,object-gensym ',class-name)))))))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (%compiler-set-up-layout ',dd ',(inherits-for-structure dd)))
+
+ ;; slot readers and writers
+ (declaim (inline ,@(mapcar #'dsd-accessor-name dd-slots)))
+ ,@(mapcar (lambda (dsd)
+ `(defun ,(dsd-accessor-name dsd) (,object-gensym)
+ ,@(when runtime-type-checks-p
+ `((declare (type ,class-name ,object-gensym))))
+ (,raw-reffer-operator ,object-gensym
+ ,(dsd-index dsd))))
+ dd-slots)
+ (declaim (inline ,@(mapcar (lambda (dsd)
+ `(setf ,(dsd-accessor-name dsd)))
+ dd-slots)))
+ ,@(mapcar (lambda (dsd)
+ `(defun (setf ,(dsd-accessor-name dsd)) (,new-value-gensym
+ ,object-gensym)
+ ,@(when runtime-type-checks-p
+ `((declare (type ,class-name ,object-gensym))))
+ (setf (,raw-reffer-operator ,object-gensym
+ ,(dsd-index dsd))
+ ,new-value-gensym)))
+ dd-slots)
+
+ ;; constructor
+ (defun ,boa-constructor ,slot-names
+ (let ((,object-gensym ,raw-maker-form))
+ ,@(mapcar (lambda (slot-name)
+ (let ((dsd (find (symbol-name slot-name) dd-slots
+ :key (lambda (x)
+ (symbol-name (dsd-name x)))
+ :test #'string=)))
+ ;; KLUDGE: bug 117 bogowarning. Neither
+ ;; DECLAREing the type nor TRULY-THE cut
+ ;; the mustard -- it still gives warnings.
+ (enforce-type dsd defstruct-slot-description)
+ `(setf (,(dsd-accessor-name dsd) ,object-gensym)
+ ,slot-name)))
+ slot-names)
+ ,object-gensym))
+
+ ;; predicate
+ ,@(when predicate
+ ;; Just delegate to the compiler's type optimization
+ ;; code, which knows how to generate inline type tests
+ ;; for the whole CMU CL INSTANCE menagerie.
+ `(defun ,predicate (,object-gensym)
+ (typep ,object-gensym ',class-name)))))))