X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/284f1fa2ace3e276052ff1bd7d66442500e693da..00091ab3d552b0ab7bc177e19e86110d8c1cd20b:/src/class-layout-impl.lisp?ds=sidebyside diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp index 3779a69..452e683 100644 --- a/src/class-layout-impl.lisp +++ b/src/class-layout-impl.lisp @@ -41,11 +41,20 @@ :key #'sod-initializer-slot)) (sod-class-precedence-list class))) +(defmethod find-slot-initargs ((class sod-class) (slot sod-slot)) + (mappend (lambda (super) + (remove-if-not (lambda (initarg) + (and (typep initarg 'sod-slot-initarg) + (eq (sod-initarg-slot initarg) slot))) + (sod-class-initargs super))) + (sod-class-precedence-list class))) + (defmethod compute-effective-slot ((class sod-class) (slot sod-slot)) (make-instance 'effective-slot :slot slot :class class - :initializer (find-slot-initializer class slot))) + :initializer (find-slot-initializer class slot) + :initargs (find-slot-initargs class slot))) ;;;-------------------------------------------------------------------------- ;;; Special-purpose slot objects. @@ -379,4 +388,22 @@ (compute-vtable class (reverse chain))) (sod-class-chains class))) +;;;-------------------------------------------------------------------------- +;;; Layout interface. + +;; Just arrange to populate the necessary slots on demand. +(flet ((check-class-is-finalized (class) + (unless (eq (sod-class-state class) :finalized) + (error "Class ~S is not finalized" class)))) + (macrolet ((define-layout-slot (slot (class) &body body) + `(define-on-demand-slot sod-class ,slot (,class) + (check-class-is-finalized ,class) + ,@body))) + (define-layout-slot %ilayout (class) + (compute-ilayout class)) + (define-layout-slot effective-methods (class) + (compute-effective-methods class)) + (define-layout-slot vtables (class) + (compute-vtables class)))) + ;;;----- That's all, folks --------------------------------------------------