527 |
(*structure-type* type) |
(*structure-type* type) |
528 |
#+lucid |
#+lucid |
529 |
(*structure-length* (structure-length x type))) |
(*structure-length* (structure-length x type))) |
530 |
(find-class-from-cell type cell)))) |
(find-class-from-cell type cell nil)))) |
531 |
(wrapper (if class (class-wrapper class) *the-wrapper-of-t*))) |
(wrapper (if class (class-wrapper class) *the-wrapper-of-t*))) |
532 |
(when (symbolp type) |
(when (symbolp type) |
533 |
(setq wft-type1 type wft-wrapper1 wrapper)) |
(setq wft-type1 type wft-wrapper1 wrapper)) |
607 |
(if (structure-type-p symbol) |
(if (structure-type-p symbol) |
608 |
(unless (eq find-structure-class symbol) |
(unless (eq find-structure-class symbol) |
609 |
(let ((find-structure-class symbol)) |
(let ((find-structure-class symbol)) |
610 |
(let ((res (ensure-class symbol |
(when (fboundp 'ensure-class) |
611 |
:metaclass 'structure-class |
(let ((res (ensure-class symbol |
612 |
:name symbol |
:metaclass 'structure-class |
613 |
:direct-superclasses |
:name symbol |
614 |
(when (structure-type-included-type-name symbol) |
:direct-superclasses |
615 |
(list (structure-type-included-type-name symbol))) |
(when (structure-type-included-type-name symbol) |
616 |
:direct-slots |
(list (structure-type-included-type-name symbol))) |
617 |
(mapcar #'slot-initargs-from-structure-slotd |
:direct-slots |
618 |
(structure-type-slot-description-list symbol))))) |
(mapcar #'slot-initargs-from-structure-slotd |
619 |
(setf (class-defstruct-constructor res) (car (si::s-data-constructors (get symbol 'si::s-data)))) |
(structure-type-slot-description-list symbol))))) |
620 |
res))) |
(setf (class-defstruct-constructor res) (car (si::s-data-constructors (get symbol 'si::s-data)))) |
621 |
|
res)))) |
622 |
(error "~S is not a legal structure class name." symbol)))) |
(error "~S is not a legal structure class name." symbol)))) |
623 |
|
|
624 |
#-cmu17 |
#-cmu17 |