X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/aa14a4cddcb96b681d5c19a2ec8bad382f43b264..6e2d4b5250ecf9cf82fcb7c5c76bdebca230150b:/src/class-output.lisp diff --git a/src/class-output.lisp b/src/class-output.lisp index 58d4830..31f3214 100644 --- a/src/class-output.lisp +++ b/src/class-output.lisp @@ -26,10 +26,39 @@ (cl:in-package #:sod) ;;;-------------------------------------------------------------------------- +;;; Walking the layout tree. + +(defmethod hook-output progn ((class sod-class) reason sequencer) + (with-slots ((ilayout %ilayout) vtables methods effective-methods) class + (hook-output ilayout reason sequencer) + (dolist (method methods) (hook-output method reason sequencer)) + (dolist (method effective-methods) (hook-output method reason sequencer)) + (dolist (vtable vtables) (hook-output vtable reason sequencer)))) + +(defmethod hook-output progn ((ilayout ilayout) reason sequencer) + (with-slots (ichains) ilayout + (dolist (ichain ichains) (hook-output ichain reason sequencer)))) + +(defmethod hook-output progn ((ichain ichain) reason sequencer) + (dolist (item (ichain-body ichain)) + (hook-output item reason sequencer))) + +(defmethod hook-output progn ((islots islots) reason sequencer) + (dolist (slot (islots-slots islots)) + (hook-output slot reason sequencer))) + +(defmethod hook-output progn ((vtable vtable) reason sequencer) + (with-slots (body) vtable + (dolist (item body) (hook-output item reason sequencer)))) + +(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer) + (with-slots (entries) vtmsgs + (dolist (entry entries) (hook-output entry reason sequencer)))) + +;;;-------------------------------------------------------------------------- ;;; Classes. -(defmethod hook-output progn ((class sod-class) (reason (eql :h)) - sequencer) +(defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer) ;; Main output sequencing. (sequence-output (stream sequencer) @@ -45,6 +74,7 @@ (class :ichains :start) (class :ichains :end) (class :ilayout :start) (class :ilayout :slots) (class :ilayout :end) (class :conversions) + (class :message-macros) (class :object) (:classes :end)) @@ -98,48 +128,84 @@ (format stream "/* Conversion macros. */~%") (dolist (super (cdr (sod-class-precedence-list class))) (let ((super-head (sod-class-chain-head super))) - (format stream "#define ~:@(~A__CONV_~A~)(p) ((~A *)~ - ~:[SOD_XCHAIN(~A, (p))~;(p)~])~%" + (format stream "#define ~:@(~A__CONV_~A~)(_obj) ((~A *)~ + ~:[SOD_XCHAIN(~A, (_obj))~;(_obj)~])~%" class (sod-class-nickname super) super (eq chain-head super-head) (sod-class-nickname super-head)))) (terpri stream))))) - ;; Generate vtmsgs structure for all superclasses. - (hook-output (car (sod-class-vtables class)) - 'vtmsgs - sequencer)) + ;; Provide convenience macros for sending the newly defined messages. (The + ;; macros work on all subclasses too.) + ;; + ;; We need each message's method entry type for this, so we need to dig it + ;; out of the vtmsgs structure. Indeed, the vtmsgs for this class contains + ;; entries for precisely the messages we want to make macros for. + (when (sod-class-messages class) + (sequence-output (stream sequencer) + ((class :message-macros) + (let* ((vtable (find (sod-class-chain-head class) + (sod-class-vtables class) + :key #'vtable-chain-head)) + (vtmsgs (find-if (lambda (item) + (and (typep item 'vtmsgs) + (eql (vtmsgs-class item) class))) + (vtable-body vtable)))) + (format stream "/* Message invocation macros. */~%") + (dolist (entry (vtmsgs-entries vtmsgs)) + (let* ((type (method-entry-function-type entry)) + (args (c-function-arguments type)) + (in-names nil) (out-names nil) (varargsp nil) (me "me")) + (do ((args args (cdr args))) + ((endp args)) + (let* ((raw-name (princ-to-string (argument-name (car args)))) + (name (if (find raw-name + (list "_vt" + (sod-class-nickname class) + (method-entry-slot-name entry)) + :test #'string=) + (format nil "sod__a_~A" raw-name) + raw-name))) + (cond ((and (cdr args) (eq (cadr args) :ellipsis)) + (setf varargsp t) + (unless in-names (setf me "SOD_CAR(__VA_ARGS__)")) + (push (format nil "/*~A*/ ..." name) in-names) + (push "__VA_ARGS__" out-names) + (return)) + (t + (push name in-names) + (push name out-names))))) + (when varargsp + (format stream "#if __STDC_VERSION__ >= 199901~%")) + (format stream "#define ~A(~{~A~^, ~}) ~ + ~A->_vt->~A.~A(~{~A~^, ~})~%" + (message-macro-name class entry) + (nreverse in-names) + me + (sod-class-nickname class) + (method-entry-slot-name entry) + (nreverse out-names)) + (when varargsp + (format stream "#endif~%")))) + (terpri stream))))) -(defmethod hook-output progn ((class sod-class) reason sequencer) - (with-slots (ilayout vtables methods effective-methods) class - (hook-output ilayout reason sequencer) - (dolist (method methods) (hook-output method reason sequencer)) - (dolist (method effective-methods) - (hook-output method reason sequencer)) - (dolist (vtable vtables) (hook-output vtable reason sequencer)))) + ;; Generate vtmsgs structure for all superclasses. + (hook-output (car (sod-class-vtables class)) 'vtmsgs sequencer)) ;;;-------------------------------------------------------------------------- ;;; Instance structure. -(defmethod hook-output progn ((slot sod-slot) (reason (eql 'islots)) - sequencer) +(defmethod hook-output progn ((slot sod-slot) + (reason (eql 'islots)) + sequencer) (sequence-output (stream sequencer) (((sod-slot-class slot) :islots :slots) (pprint-logical-block (stream nil :prefix " " :suffix ";") (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot))) (terpri stream)))) -(defmethod hook-output progn ((ilayout ilayout) reason sequencer) - (with-slots (ichains) ilayout - (dolist (ichain ichains) (hook-output ichain reason sequencer)))) - -(defmethod hook-output progn ((ichain ichain) reason sequencer) - (dolist (item (ichain-body ichain)) - (hook-output item reason sequencer))) - -(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) - sequencer) - (with-slots (class ichains) ilayout +(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer) + (with-slots ((class %class) ichains) ilayout (sequence-output (stream sequencer) ((class :ilayout :start) (format stream "/* Instance layout. */~@ @@ -150,9 +216,8 @@ (dolist (ichain ichains) (hook-output ichain 'ilayout sequencer)))) -(defmethod hook-output progn ((ichain ichain) (reason (eql :h)) - sequencer) - (with-slots (class chain-head chain-tail) ichain +(defmethod hook-output progn ((ichain ichain) (reason (eql :h)) sequencer) + (with-slots ((class %class) chain-head chain-tail) ichain (when (eq class chain-tail) (sequence-output (stream sequencer) :constraint ((class :ichains :start) @@ -180,30 +245,27 @@ (sod-class-nickname super))) (sod-class-chain chain-tail)))))))) -(defmethod hook-output progn ((ichain ichain) (reason (eql 'ilayout)) - sequencer) - (with-slots (class chain-head chain-tail) ichain +(defmethod hook-output progn ((ichain ichain) + (reason (eql 'ilayout)) + sequencer) + (with-slots ((class %class) chain-head chain-tail) ichain (sequence-output (stream sequencer) ((class :ilayout :slots) (format stream " union ~A ~A;~%" (ichain-union-tag chain-tail chain-head) (sod-class-nickname chain-head)))))) -(defmethod hook-output progn ((vtptr vtable-pointer) (reason (eql :h)) - sequencer) - (with-slots (class chain-head chain-tail) vtptr +(defmethod hook-output progn ((vtptr vtable-pointer) + (reason (eql :h)) + sequencer) + (with-slots ((class %class) chain-head chain-tail) vtptr (sequence-output (stream sequencer) ((class :ichain chain-head :slots) (format stream " const struct ~A *_vt;~%" (vtable-struct-tag chain-tail chain-head)))))) -(defmethod hook-output progn ((islots islots) reason sequencer) - (dolist (slot (islots-slots islots)) - (hook-output slot reason sequencer))) - -(defmethod hook-output progn ((islots islots) (reason (eql :h)) - sequencer) - (with-slots (class subclass slots) islots +(defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer) + (with-slots ((class %class) subclass slots) islots (sequence-output (stream sequencer) ((subclass :ichain (sod-class-chain-head class) :slots) (format stream " struct ~A ~A;~%" @@ -213,13 +275,10 @@ ;;;-------------------------------------------------------------------------- ;;; Vtable structure. -(defmethod hook-output progn ((vtable vtable) reason sequencer) - (with-slots (body) vtable - (dolist (item body) (hook-output item reason sequencer)))) - -(defmethod hook-output progn ((method sod-method) (reason (eql :h)) - sequencer) - (with-slots (class) method +(defmethod hook-output progn ((method sod-method) + (reason (eql :h)) + sequencer) + (with-slots ((class %class)) method (sequence-output (stream sequencer) ((class :methods) (let ((type (sod-method-function-type method))) @@ -228,9 +287,8 @@ (sod-method-function-name method)) (format stream ";~%")))))) -(defmethod hook-output progn ((vtable vtable) (reason (eql :h)) - sequencer) - (with-slots (class chain-head chain-tail) vtable +(defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer) + (with-slots ((class %class) chain-head chain-tail) vtable (when (eq class chain-tail) (sequence-output (stream sequencer) :constraint ((class :vtables :start) @@ -243,26 +301,38 @@ struct ~A {~%" (vtable-struct-tag chain-tail chain-head))) ((class :vtable chain-head :end) - (format stream "};~2%")))) + (format stream "};~2%") + (format stream "/* Union of equivalent superclass vtables. */~@ + union ~A {~@ + ~:{ struct ~A ~A;~%~}~ + };~2%" + (vtable-union-tag chain-tail chain-head) + + ;; As for the ichain union, make sure the most specific + ;; class is first. + (mapcar (lambda (super) + (list (vtable-struct-tag super chain-head) + (sod-class-nickname super))) + (sod-class-chain chain-tail)))))) (sequence-output (stream sequencer) ((class :vtable-externs) - (format stream "~@~%" - (vtable-struct-tag chain-tail chain-head) - class (sod-class-nickname chain-head)))))) + (format stream "~@~%" + (vtable-union-tag chain-tail chain-head) + (vtable-name class chain-head)))))) -(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) - sequencer) - (with-slots (class subclass chain-head chain-tail) vtmsgs +(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer) + (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs (sequence-output (stream sequencer) ((subclass :vtable chain-head :slots) (format stream " struct ~A ~A;~%" (vtmsgs-struct-tag subclass class) (sod-class-nickname class)))))) -(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) - sequencer) +(defmethod hook-output progn ((vtmsgs vtmsgs) + (reason (eql 'vtmsgs)) + sequencer) (when (vtmsgs-entries vtmsgs) - (with-slots (class subclass) vtmsgs + (with-slots ((class %class) subclass) vtmsgs (sequence-output (stream sequencer) :constraint ((subclass :vtmsgs :start) (subclass :vtmsgs class :start) @@ -277,48 +347,42 @@ ((subclass :vtmsgs class :end) (format stream "};~2%")))))) -(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer) - (with-slots (entries) vtmsgs - (dolist (entry entries) (hook-output entry reason sequencer)))) - -(defmethod hook-output progn ((entry method-entry) reason sequencer) - (with-slots (method) entry - (hook-output method reason sequencer))) - -(defmethod hook-output progn ((entry method-entry) (reason (eql 'vtmsgs)) - sequencer) +(defmethod hook-output progn ((entry method-entry) + (reason (eql 'vtmsgs)) + sequencer) (let* ((method (method-entry-effective-method entry)) (message (effective-method-message method)) (class (effective-method-class method)) - (type (method-entry-function-type entry)) - (commented-type (commentify-function-type type))) + (function-type (method-entry-function-type entry)) + (commented-type (commentify-function-type function-type)) + (pointer-type (make-pointer-type commented-type))) (sequence-output (stream sequencer) ((class :vtmsgs (sod-message-class message) :slots) (pprint-logical-block (stream nil :prefix " " :suffix ";") - (pprint-c-type commented-type stream (sod-message-name message))) + (pprint-c-type pointer-type stream (method-entry-slot-name entry))) (terpri stream))))) -(defmethod hook-output progn ((cptr class-pointer) (reason (eql :h)) - sequencer) - (with-slots (class chain-head metaclass meta-chain-head) cptr +(defmethod hook-output progn ((cptr class-pointer) + (reason (eql :h)) + sequencer) + (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr (sequence-output (stream sequencer) ((class :vtable chain-head :slots) (format stream " const ~A *~:[_class~;~:*_cls_~A~];~%" metaclass - (if (sod-class-direct-superclasses meta-chain-head) - (sod-class-nickname meta-chain-head) - nil)))))) + (and (sod-class-direct-superclasses meta-chain-head) + (sod-class-nickname meta-chain-head))))))) -(defmethod hook-output progn ((boff base-offset) (reason (eql :h)) - sequencer) - (with-slots (class chain-head) boff +(defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer) + (with-slots ((class %class) chain-head) boff (sequence-output (stream sequencer) ((class :vtable chain-head :slots) (write-line " size_t _base;" stream))))) -(defmethod hook-output progn ((choff chain-offset) (reason (eql :h)) - sequencer) - (with-slots (class chain-head target-head) choff +(defmethod hook-output progn ((choff chain-offset) + (reason (eql :h)) + sequencer) + (with-slots ((class %class) chain-head target-head) choff (sequence-output (stream sequencer) ((class :vtable chain-head :slots) (format stream " ptrdiff_t _off_~A;~%" @@ -327,10 +391,10 @@ ;;;-------------------------------------------------------------------------- ;;; Implementation output. +(export '*instance-class*) (defvar *instance-class*) -(defmethod hook-output progn ((class sod-class) (reason (eql :c)) - sequencer) +(defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer) (sequence-output (stream sequencer) :constraint @@ -356,15 +420,15 @@ const struct ~A ~A__classobj = {~%" (let ((*instance-class* class)) (hook-output (sod-class-ilayout (sod-class-metaclass class)) - 'class - sequencer))) + 'class sequencer))) ;;;-------------------------------------------------------------------------- -;;; Direct methods. +;;; Direct and effective methods. -(defmethod hook-output progn ((method delegating-direct-method) (reason (eql :c)) - sequencer) - (with-slots (class body) method +(defmethod hook-output progn ((method delegating-direct-method) + (reason (eql :c)) + sequencer) + (with-slots ((class %class) body) method (unless body (return-from hook-output)) (sequence-output (stream sequencer) @@ -376,9 +440,10 @@ const struct ~A ~A__classobj = {~%" ((class :direct-method method :end) (format stream "#undef CALL_NEXT_METHOD~%"))))) -(defmethod hook-output progn ((method sod-method) (reason (eql :c)) - sequencer) - (with-slots (class body) method +(defmethod hook-output progn ((method sod-method) + (reason (eql :c)) + sequencer) + (with-slots ((class %class) body) method (unless body (return-from hook-output)) (sequence-output (stream sequencer) @@ -397,9 +462,10 @@ const struct ~A ~A__classobj = {~%" ((class :direct-method method :end) (terpri stream))))) -(defmethod hook-output progn ((method basic-effective-method) (reason (eql :c)) +(defmethod hook-output progn ((method basic-effective-method) + (reason (eql :c)) sequencer) - (with-slots (class functions) method + (with-slots ((class %class) functions) method (sequence-output (stream sequencer) ((class :effective-methods) (dolist (func functions) @@ -408,9 +474,8 @@ const struct ~A ~A__classobj = {~%" ;;;-------------------------------------------------------------------------- ;;; Vtables. -(defmethod hook-output progn ((vtable vtable) (reason (eql :c)) - sequencer) - (with-slots (class chain-head chain-tail) vtable +(defmethod hook-output progn ((vtable vtable) (reason (eql :c)) sequencer) + (with-slots ((class %class) chain-head chain-tail) vtable (sequence-output (stream sequencer) :constraint ((class :vtables :start) (class :vtable chain-head :start) @@ -418,54 +483,60 @@ const struct ~A ~A__classobj = {~%" (class :vtables :end)) ((class :vtable chain-head :start) (format stream "/* Vtable for ~A chain. */~@ - static const struct ~A ~A = {~%" + const union ~A ~A = { {~%" chain-head - (vtable-struct-tag chain-tail chain-head) - (vtable-name chain-tail chain-head))) + (vtable-union-tag chain-tail chain-head) + (vtable-name class chain-head))) ((class :vtable chain-head :end) - (format stream "};~2%"))))) + (format stream "} };~2%"))))) -(defmethod hook-output progn ((cptr class-pointer) (reason (eql :c)) - sequencer) - (with-slots (class chain-head metaclass meta-chain-head) cptr +(defmethod hook-output progn ((cptr class-pointer) + (reason (eql :c)) + sequencer) + (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) (class :vtable chain-head :class-pointer metaclass) (class :vtable chain-head :end)) ((class :vtable chain-head :class-pointer metaclass) - (format stream " &~A__classobj.~A.~A,~%" - (sod-class-metaclass class) + (format stream " /* ~21@A = */ &~A__classobj.~A.~A,~%" + (if (sod-class-direct-superclasses meta-chain-head) + (format nil "_cls_~A" + (sod-class-nickname meta-chain-head)) + "_class") + class (sod-class-nickname meta-chain-head) (sod-class-nickname metaclass)))))) -(defmethod hook-output progn ((boff base-offset) (reason (eql :c)) - sequencer) - (with-slots (class chain-head) boff +(defmethod hook-output progn ((boff base-offset) (reason (eql :c)) sequencer) + (with-slots ((class %class) chain-head) boff (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) (class :vtable chain-head :base-offset) (class :vtable chain-head :end)) ((class :vtable chain-head :base-offset) - (format stream " offsetof(struct ~A, ~A),~%" + (format stream " /* ~21@A = */ offsetof(struct ~A, ~A),~%" + "_base" (ilayout-struct-tag class) (sod-class-nickname chain-head)))))) -(defmethod hook-output progn ((choff chain-offset) (reason (eql :c)) - sequencer) - (with-slots (class chain-head target-head) choff +(defmethod hook-output progn ((choff chain-offset) + (reason (eql :c)) + sequencer) + (with-slots ((class %class) chain-head target-head) choff (sequence-output (stream sequencer) :constraint ((class :vtable chain-head :start) (class :vtable chain-head :chain-offset target-head) (class :vtable chain-head :end)) ((class :vtable chain-head :chain-offset target-head) - (format stream " SOD_OFFSETDIFF(struct ~A, ~A, ~A),~%" + (format stream " /* ~21@A = */ SOD_OFFSETDIFF(struct ~A, ~A, ~A),~%" + (format nil "_off_~A" (sod-class-nickname target-head)) (ilayout-struct-tag class) (sod-class-nickname chain-head) (sod-class-nickname target-head)))))) -(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) - sequencer) - (with-slots (class subclass chain-head) vtmsgs +(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer) + (with-slots ((class %class) subclass chain-head) vtmsgs (sequence-output (stream sequencer) :constraint ((subclass :vtable chain-head :start) (subclass :vtable chain-head :vtmsgs class :start) @@ -478,23 +549,26 @@ const struct ~A ~A__classobj = {~%" ((subclass :vtable chain-head :vtmsgs class :end) (format stream " },~%"))))) -(defmethod hook-output progn ((entry method-entry) (reason (eql :c)) - sequencer) - (with-slots (method chain-head chain-tail) entry +(defmethod hook-output progn ((entry method-entry) + (reason (eql :c)) + sequencer) + (with-slots ((method %method) chain-head chain-tail role) entry (let* ((message (effective-method-message method)) (class (effective-method-class method)) (super (sod-message-class message))) (sequence-output (stream sequencer) ((class :vtable chain-head :vtmsgs super :slots) - (format stream " ~A,~%" - (method-entry-function-name method chain-head))))))) + (format stream " /* ~19@A = */ ~A,~%" + (method-entry-slot-name entry) + (method-entry-function-name method chain-head role))))))) ;;;-------------------------------------------------------------------------- ;;; Filling in the class object. -(defmethod hook-output progn ((ichain ichain) (reason (eql 'class)) - sequencer) - (with-slots (class chain-head) ichain +(defmethod hook-output progn ((ichain ichain) + (reason (eql 'class)) + sequencer) + (with-slots ((class %class) chain-head) ichain (sequence-output (stream sequencer) :constraint ((*instance-class* :object :start) (*instance-class* :object chain-head :ichain :start) @@ -506,9 +580,10 @@ const struct ~A ~A__classobj = {~%" ((*instance-class* :object chain-head :ichain :end) (format stream " } },~%"))))) -(defmethod hook-output progn ((islots islots) (reason (eql 'class)) - sequencer) - (with-slots (class) islots +(defmethod hook-output progn ((islots islots) + (reason (eql 'class)) + sequencer) + (with-slots ((class %class)) islots (let ((chain-head (sod-class-chain-head class))) (sequence-output (stream sequencer) :constraint ((*instance-class* :object chain-head :ichain :start) @@ -521,16 +596,19 @@ const struct ~A ~A__classobj = {~%" ((*instance-class* :object class :slots :end) (format stream " },~%")))))) -(defmethod hook-output progn ((vtptr vtable-pointer) (reason (eql 'class)) - sequencer) - (with-slots (class chain-head chain-tail) vtptr +(defmethod hook-output progn ((vtptr vtable-pointer) + (reason (eql 'class)) + sequencer) + (with-slots ((class %class) chain-head chain-tail) vtptr (sequence-output (stream sequencer) :constraint ((*instance-class* :object chain-head :ichain :start) (*instance-class* :object chain-head :vtable) (*instance-class* :object chain-head :ichain :end)) ((*instance-class* :object chain-head :vtable) - (format stream " &~A__vtable_~A,~%" - class (sod-class-nickname chain-head)))))) + (format stream " /* ~17@A = */ &~A.~A,~%" + "_vt" + (vtable-name class chain-head) + (sod-class-nickname chain-tail)))))) (defgeneric find-class-initializer (slot class) (:method ((slot effective-slot) (class sod-class)) @@ -543,20 +621,27 @@ const struct ~A ~A__classobj = {~%" (defgeneric output-class-initializer (slot instance stream) (:method ((slot sod-class-effective-slot) (instance sod-class) stream) - (let ((func (effective-slot-initializer-function slot))) + (let ((func (effective-slot-initializer-function slot)) + (direct-slot (effective-slot-direct-slot slot))) (if func - (format stream " ~A,~%" (funcall func instance)) + (format stream " /* ~15@A = */ ~A,~%" + (sod-slot-name direct-slot) + (funcall func instance)) (call-next-method)))) (:method ((slot effective-slot) (instance sod-class) stream) - (let ((init (find-class-initializer slot instance))) + (let ((init (find-class-initializer slot instance)) + (direct-slot (effective-slot-direct-slot slot))) (ecase (sod-initializer-value-kind init) - (:simple (format stream " ~A,~%" + (:simple (format stream " /* ~15@A = */ ~A,~%" + (sod-slot-name direct-slot) (sod-initializer-value-form init))) - (:compound (format stream " ~@<{ ~;~A~; },~:>~%" - (sod-initializer-value-form init))))))) + (:compound (format stream " /* ~15@A = */ ~@<{ ~;~A~; },~:>~%" + (sod-slot-name direct-slot) + (sod-initializer-value-form init))))))) -(defmethod hook-output progn ((slot sod-class-effective-slot) (reason (eql 'class)) - sequencer) +(defmethod hook-output progn ((slot sod-class-effective-slot) + (reason (eql 'class)) + sequencer) (let ((instance *instance-class*) (func (effective-slot-prepare-function slot))) (when func @@ -564,9 +649,10 @@ const struct ~A ~A__classobj = {~%" ((instance :object :prepare) (funcall func instance stream)))))) -(defmethod hook-output progn ((slot effective-slot) (reason (eql 'class)) - sequencer) - (with-slots (class (dslot slot)) slot +(defmethod hook-output progn ((slot effective-slot) + (reason (eql 'class)) + sequencer) + (with-slots ((class %class) (dslot slot)) slot (let ((instance *instance-class*) (super (sod-slot-class dslot))) (sequence-output (stream sequencer)