From: Mark Wooding Date: Thu, 22 Aug 2019 23:39:07 +0000 (+0100) Subject: src/class-output.lisp: Add docstrings to the `hook-output' methods. X-Git-Url: https://git.distorted.org.uk/~mdw/sod/commitdiff_plain/6b875a6dc26c156d139cb0fb70a09816e132b8bc src/class-output.lisp: Add docstrings to the `hook-output' methods. --- diff --git a/src/class-output.lisp b/src/class-output.lisp index f2d3e43..ef82355 100644 --- a/src/class-output.lisp +++ b/src/class-output.lisp @@ -29,6 +29,8 @@ ;;; Walking the layout tree. (defmethod hook-output :after ((class sod-class) reason sequencer) + "Register hooks for the class layout, direct methods, effective methods, + and vtables." (with-slots ((ilayout %ilayout) vtables methods effective-methods) class (hook-output ilayout reason sequencer) (dolist (method methods) (hook-output method reason sequencer)) @@ -36,20 +38,25 @@ (dolist (vtable vtables) (hook-output vtable reason sequencer)))) (defmethod hook-output :after ((ilayout ilayout) reason sequencer) + "Register hooks for the layout's ichains." (with-slots (ichains) ilayout (dolist (ichain ichains) (hook-output ichain reason sequencer)))) (defmethod hook-output :after ((ichain ichain) reason sequencer) + "Register hooks for the ichain body's items." (dolist (item (ichain-body ichain)) (hook-output item reason sequencer))) (defmethod hook-output :after ((islots islots) reason sequencer) + "Register hooks for the islots structure's individual slots." (dolist (slot (islots-slots islots)) (hook-output slot reason sequencer))) (defmethod hook-output :after ((vtable vtable) reason sequencer) + "Register hooks for the vtable body's items." (with-slots (body) vtable (dolist (item body) (hook-output item reason sequencer)))) (defmethod hook-output :after ((vtmsgs vtmsgs) reason sequencer) + "Register hooks for the vtmsgs structure's individual method entries." (with-slots (entries) vtmsgs (dolist (entry entries) (hook-output entry reason sequencer)))) @@ -188,6 +195,24 @@ (when varargsp (format stream "#endif~%")))) (defmethod hook-output ((class sod-class) (reason (eql :h)) sequencer) + "Write the skeleton of a class declaration. + + Most of the work is done by other functions. + + * The class type is defined by `emit-class-typedef'. + + * The class object is declared by `emit-class-object-decl'. + + * The upcast conversion macros are defined by `emit-class-conversion- + macro'. + + * The message invocation macros are defined by `emit-message-macro'. + + * The class instance structure itself is constructed by the `ilayout' + object. + + * The various vtable structures are constructed by the `vtable' + objects." ;; Main output sequencing. (sequence-output (stream sequencer) @@ -271,6 +296,7 @@ (terpri stream)))))) (defmethod hook-output :after ((class sod-class) (reason (eql :h)) sequencer) + "Register hooks to output CLASS's direct slots and messages." ;; Output a structure member definition for each instance slot. (dolist (slot (sod-class-slots class)) @@ -283,6 +309,7 @@ ;;; Instance structure. (defmethod hook-output ((slot sod-slot) (reason (eql 'islots)) sequencer) + "Declare the member for an individual slot within an `islots' structure." (sequence-output (stream sequencer) (((sod-slot-class slot) :islots :slots) (pprint-logical-block (stream nil :prefix " " :suffix ";") @@ -290,7 +317,11 @@ (terpri stream)))) (defmethod hook-output ((ilayout ilayout) (reason (eql :h)) sequencer) - (with-slots ((class %class)) ilayout + "Define the structure for a class layout. + + Here we just provide the outermost structure. It gets filled in by + the `ichains' objects and their body items." + (with-slots ((class %class) ichains) ilayout (sequence-output (stream sequencer) ((class :ilayout :start) (format stream "/* Instance layout. */~@ @@ -300,10 +331,19 @@ (format stream "};~2%"))))) (defmethod hook-output :after ((ilayout ilayout) (reason (eql :h)) sequencer) + "Register hooks to write chain members into the overall class layout." (dolist (ichain (ilayout-ichains ilayout)) (hook-output ichain 'ilayout sequencer))) (defmethod hook-output ((ichain ichain) (reason (eql :h)) sequencer) + "Define the layout structure for a particular chain of a class. + + A member of this class is dropped into the `ilayout' structure by the + corresponding method for the `ilayout' reason. + + We define both the chain structure of the class, and a union of it with + all of its in-chain superclasses (so as to invoke the common-prefix + rule)." (with-slots ((class %class) chain-head chain-tail) ichain (when (eq class chain-tail) (sequence-output (stream sequencer) @@ -333,6 +373,7 @@ (sod-class-chain chain-tail)))))))) (defmethod hook-output ((ichain ichain) (reason (eql 'ilayout)) sequencer) + "Declare the member for a class chain within the class layout." (with-slots ((class %class) chain-head chain-tail) ichain (sequence-output (stream sequencer) ((class :ilayout :slots) @@ -341,6 +382,7 @@ (sod-class-nickname chain-head)))))) (defmethod hook-output ((vtptr vtable-pointer) (reason (eql :h)) sequencer) + "Declare the member for a vtable pointer within an `ichain' structure." (with-slots ((class %class) chain-head chain-tail) vtptr (when (eq class chain-tail) (sequence-output (stream sequencer) @@ -349,6 +391,7 @@ (vtable-struct-tag chain-tail chain-head))))))) (defmethod hook-output ((islots islots) (reason (eql :h)) sequencer) + "Declare the member for a class's `islots' within an `ichain' structure." (with-slots ((class %class) subclass slots) islots (let ((head (sod-class-chain-head class))) (when (eq head (sod-class-chain-head subclass)) @@ -362,6 +405,11 @@ ;;; Vtable structure. (defmethod hook-output ((method sod-method) (reason (eql :h)) sequencer) + "Emit declarations for a direct method. + + We declare the direct method function, and, if necessary, the `suppliedp' + structure for its keyword arguments." + (with-slots ((class %class)) method (sequence-output (stream sequencer) ((class :methods) @@ -382,6 +430,11 @@ (mapcar #'argument-name keys)))))))) (defmethod hook-output ((vtable vtable) (reason (eql :h)) sequencer) + "Define the structure for a vtable. + + We define the vtable structure of the class, and a union of it with all of + its in-chain superclasses (so as to invoke the common-prefix rule). We + also declare the vtable object, defined by the corresponding `:c' method." (with-slots ((class %class) chain-head chain-tail) vtable (when (eq class chain-tail) (sequence-output (stream sequencer) @@ -415,6 +468,7 @@ (vtable-name class chain-head)))))) (defmethod hook-output ((vtmsgs vtmsgs) (reason (eql :h)) sequencer) + "Declare the member for a class's `vtmsgs' within a `vtable' structure." (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs (when (eq subclass chain-tail) (sequence-output (stream sequencer) @@ -424,6 +478,7 @@ (sod-class-nickname class))))))) (defmethod hook-output ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) sequencer) + "Define the `vtmsgs' structure for a class's method entry functions." (when (vtmsgs-entries vtmsgs) (with-slots ((class %class) subclass) vtmsgs (sequence-output (stream sequencer) @@ -442,6 +497,7 @@ (defmethod hook-output ((entry method-entry) (reason (eql 'vtmsgs)) sequencer) + "Declare the member for a method entry within a `vtmsgs' structure." (let* ((method (method-entry-effective-method entry)) (message (effective-method-message method)) (class (effective-method-class method)) @@ -455,6 +511,7 @@ (terpri stream))))) (defmethod hook-output ((cptr class-pointer) (reason (eql :h)) sequencer) + "Declare the member for a class-chain pointer within a `vtmsgs' structure." (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr (when (eq chain-head (sod-class-chain-head class)) (sequence-output (stream sequencer) @@ -465,6 +522,7 @@ (sod-class-nickname meta-chain-head)))))))) (defmethod hook-output ((boff base-offset) (reason (eql :h)) sequencer) + "Declare the member for the base offset within a `vtmsgs' structure." (with-slots ((class %class) chain-head) boff (when (eq chain-head (sod-class-chain-head class)) (sequence-output (stream sequencer) @@ -472,6 +530,7 @@ (write-line " size_t _base;" stream)))))) (defmethod hook-output ((choff chain-offset) (reason (eql :h)) sequencer) + "Declare the member for a cross-chain offset within a `vtmsgs' structure." (with-slots ((class %class) chain-head target-head) choff (when (eq chain-head (sod-class-chain-head class)) (sequence-output (stream sequencer) @@ -494,6 +553,21 @@ It may be bound at other times.") (defmethod hook-output ((class sod-class) (reason (eql :c)) sequencer) + "Write the skeleton of a class definition. + + Most of the work is done by other methods. + + * The direct methods are defined by the `sod-method' objects. + + * The effective method functions and related structures are defined by + the effective method objects. + + * The vtable structures are initialized by the vtable objects and their + component items. + + * The class structure and its associated tables are initialized by the + metaclass's layout objects." + (sequence-output (stream sequencer) :constraint @@ -518,6 +592,7 @@ const struct ~A ~A__classobj = {~%" (format stream "};~2%")))) (defmethod hook-output :after ((class sod-class) (reason (eql :c)) sequencer) + "Register hooks to initialize the class object structure." (let ((*instance-class* class)) (hook-output (sod-class-ilayout (sod-class-metaclass class)) 'class sequencer))) @@ -527,6 +602,7 @@ const struct ~A ~A__classobj = {~%" (defmethod hook-output ((method delegating-direct-method) (reason (eql :c)) sequencer) + "Define the `CALL_NEXT_METHOD' macro around a `delegating-direct-method'." (with-slots ((class %class) body) method (unless body (return-from hook-output)) @@ -541,6 +617,7 @@ const struct ~A ~A__classobj = {~%" (call-next-method)) (defmethod hook-output ((method sod-method) (reason (eql :c)) sequencer) + "Define a direct method function." (with-slots ((class %class) role body message) method (unless body (return-from hook-output)) @@ -572,6 +649,10 @@ const struct ~A ~A__classobj = {~%" (defmethod hook-output ((method basic-effective-method) (reason (eql :c)) sequencer) + "Define an effective method's functions. + + Specifically, the method-entry functions and any auxiliary functions + needed to stitch everything together." (with-slots ((class %class) functions) method (sequence-output (stream sequencer) ((class :effective-methods) @@ -600,6 +681,10 @@ const struct ~A ~A__classobj = {~%" ;;; Vtables. (defmethod hook-output ((vtable vtable) (reason (eql :c)) sequencer) + "Define a vtable structure. + + Here we just provide the outermost structure. It gets filled in by the + vtable object's body items." (with-slots ((class %class) chain-head chain-tail) vtable (sequence-output (stream sequencer) :constraint ((class :vtables :start) @@ -616,6 +701,7 @@ const struct ~A ~A__classobj = {~%" (format stream "} };~2%"))))) (defmethod hook-output ((cptr class-pointer) (reason (eql :c)) sequencer) + "Drop a class pointer into a vtable definition." (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) @@ -632,6 +718,7 @@ const struct ~A ~A__classobj = {~%" (sod-class-nickname metaclass)))))) (defmethod hook-output ((boff base-offset) (reason (eql :c)) sequencer) + "Drop a base offset into a vtable definition." (with-slots ((class %class) chain-head) boff (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) @@ -644,6 +731,7 @@ const struct ~A ~A__classobj = {~%" (sod-class-nickname chain-head)))))) (defmethod hook-output ((choff chain-offset) (reason (eql :c)) sequencer) + "Drop a cross-chain offset into a vtable definition." (with-slots ((class %class) chain-head target-head) choff (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) @@ -657,6 +745,10 @@ const struct ~A ~A__classobj = {~%" (sod-class-nickname target-head)))))) (defmethod hook-output ((vtmsgs vtmsgs) (reason (eql :c)) sequencer) + "Define the method entry pointers for a superclass's messages. + + We only provide the outer structure. It gets filled in by the + `method-entry' objects." (with-slots ((class %class) subclass chain-head) vtmsgs (sequence-output (stream sequencer) :constraint ((subclass :vtable chain-head :start) @@ -671,6 +763,7 @@ const struct ~A ~A__classobj = {~%" (format stream " },~%"))))) (defmethod hook-output ((entry method-entry) (reason (eql :c)) sequencer) + "Define a method-entry pointer in a vtable." (with-slots ((method %method) chain-head chain-tail role) entry (let* ((message (effective-method-message method)) (class (effective-method-class method)) @@ -685,6 +778,10 @@ const struct ~A ~A__classobj = {~%" ;;; Filling in the class object. (defmethod hook-output ((ichain ichain) (reason (eql 'class)) sequencer) + "Define an instance chain of a class object. + + Here we only provide the outer structure. It gets filled in by the + `ichain' object's body items." (with-slots ((class %class) chain-head) ichain (sequence-output (stream sequencer) :constraint ((*instance-class* :object :start) @@ -698,6 +795,10 @@ const struct ~A ~A__classobj = {~%" (format stream " } },~%"))))) (defmethod hook-output ((islots islots) (reason (eql 'class)) sequencer) + "Define an instance's slots in a class object. + + Here we only provide the outer structure. It gets filled in by the + individual slot objects." (with-slots ((class %class)) islots (let ((chain-head (sod-class-chain-head class))) (sequence-output (stream sequencer) @@ -713,6 +814,7 @@ const struct ~A ~A__classobj = {~%" (defmethod hook-output ((vtptr vtable-pointer) (reason (eql 'class)) sequencer) + "Define a vtable pointer in a class object." (with-slots ((class %class) chain-head chain-tail) vtptr (sequence-output (stream sequencer) :constraint ((*instance-class* :object chain-head :ichain :start) @@ -725,7 +827,11 @@ const struct ~A ~A__classobj = {~%" (sod-class-nickname chain-tail)))))) (defgeneric output-class-initializer (slot instance stream) + (:documentation + "Define an individual slot in a class object.") (:method ((slot sod-class-effective-slot) (instance sod-class) stream) + "If this slot has an initializer function, then call it; otherwise try to + find an initializer as usual." (let ((func (effective-slot-initializer-function slot)) (direct-slot (effective-slot-direct-slot slot))) (if func @@ -734,6 +840,7 @@ const struct ~A ~A__classobj = {~%" (funcall func instance)) (call-next-method)))) (:method ((slot effective-slot) (instance sod-class) stream) + "Initialize a class slot by looking up an applicable initializer." (let ((init (find-class-initializer slot instance)) (direct-slot (effective-slot-direct-slot slot))) (format stream " /* ~15@A = */ ~A,~%" @@ -742,6 +849,8 @@ const struct ~A ~A__classobj = {~%" (defmethod hook-output ((slot sod-class-effective-slot) (reason (eql 'class)) sequencer) + "Write any necessary preparatory definitions for a class slot with a + computed initializer." (let ((instance *instance-class*) (func (effective-slot-prepare-function slot))) (when func @@ -752,6 +861,7 @@ const struct ~A ~A__classobj = {~%" (defmethod hook-output ((slot effective-slot) (reason (eql 'class)) sequencer) + "Define a slot in a class object." (with-slots ((class %class) (dslot slot)) slot (let ((instance *instance-class*) (super (sod-slot-class dslot)))