224 |
(setf (wrapper-class-slots wrapper) |
(setf (wrapper-class-slots wrapper) |
225 |
())) |
())) |
226 |
|
|
227 |
(setq proto (if (eq meta 'funcallable-standard-class) |
(setq proto (if (eq name 'function) #'cons ;;FIXME -- not necessary |
228 |
|
(if (eq meta 'funcallable-standard-class) |
229 |
(allocate-funcallable-instance wrapper) |
(allocate-funcallable-instance wrapper) |
230 |
(allocate-standard-instance wrapper))) |
(allocate-standard-instance wrapper)))) |
231 |
|
|
232 |
(setq direct-slots |
(setq direct-slots |
233 |
(bootstrap-make-slot-definitions |
(bootstrap-make-slot-definitions |
463 |
(let* ((built-in-class (find-class 'built-in-class)) |
(let* ((built-in-class (find-class 'built-in-class)) |
464 |
(built-in-class-wrapper (class-wrapper built-in-class))) |
(built-in-class-wrapper (class-wrapper built-in-class))) |
465 |
(dolist (e *built-in-classes*) |
(dolist (e *built-in-classes*) |
466 |
(let ((class (allocate-standard-instance built-in-class-wrapper))) |
(unless (find-class (car e) nil) |
467 |
(setf (find-class (car e)) class)))) |
(let ((class (allocate-standard-instance built-in-class-wrapper))) |
468 |
|
(setf (find-class (car e)) class))))) |
469 |
|
|
470 |
;; |
;; |
471 |
;; In the second pass, we initialize the class objects. |
;; In the second pass, we initialize the class objects. |
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 |
(ensure-class symbol |
(let ((res (ensure-class symbol |
611 |
:metaclass 'structure-class |
:metaclass 'structure-class |
612 |
:name symbol |
:name symbol |
613 |
:direct-superclasses |
:direct-superclasses |
614 |
(when (structure-type-included-type-name symbol) |
(when (structure-type-included-type-name symbol) |
615 |
(list (structure-type-included-type-name symbol))) |
(list (structure-type-included-type-name symbol))) |
616 |
:direct-slots |
:direct-slots |
617 |
(mapcar #'slot-initargs-from-structure-slotd |
(mapcar #'slot-initargs-from-structure-slotd |
618 |
(structure-type-slot-description-list symbol))))) |
(structure-type-slot-description-list symbol))))) |
619 |
|
(setf (class-defstruct-constructor res) (car (si::s-data-constructors (get symbol 'si::s-data)))) |
620 |
|
res))) |
621 |
(error "~S is not a legal structure class name." symbol)))) |
(error "~S is not a legal structure class name." symbol)))) |
622 |
|
|
623 |
#-cmu17 |
#-cmu17 |