X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/7f2917d28642cfbdf590ff26f0cdd91a79b1c489..00091ab3d552b0ab7bc177e19e86110d8c1cd20b:/src/class-layout-impl.lisp diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp index 8f14e1e..452e683 100644 --- a/src/class-layout-impl.lisp +++ b/src/class-layout-impl.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; This file is part of the Sensible Object Design, an object system for C. ;;; ;;; SOD is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -41,11 +41,20 @@ (defmethod find-slot-initializer ((class sod-class) (slot sod-slot)) :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. @@ -117,7 +126,7 @@ (defmethod compute-sod-effective-method (sod-class-methods super) :key #'sod-method-message :test-not #'eql)) - (sod-class-precedence-list class)))) + (sod-class-precedence-list class)))) (make-instance (sod-message-effective-method-class message) :message message :class class @@ -379,4 +388,22 @@ (defmethod compute-vtables ((class sod-class)) (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 --------------------------------------------------