X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1d8cc67a3f4ded443f5efc673a616883cbae9c50..7a35400d896e6697902c2880afeba66965bd0f38:/src/class-layout-impl.lisp diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp index 3a5b5cd..950db2b 100644 --- a/src/class-layout-impl.lisp +++ b/src/class-layout-impl.lisp @@ -104,9 +104,10 @@ (defmethod print-object ((entry method-entry) stream) (maybe-print-unreadable-object (entry stream :type t) - (format stream "~A:~A" + (format stream "~A:~A~@[ ~S~]" (method-entry-effective-method entry) - (sod-class-nickname (method-entry-chain-head entry))))) + (sod-class-nickname (method-entry-chain-head entry)) + (method-entry-role entry)))) (defmethod compute-sod-effective-method ((message sod-message) (class sod-class)) @@ -229,17 +230,17 @@ (subclass sod-class) (chain-head sod-class) (chain-tail sod-class)) - (flet ((make-entry (message) + (flet ((make-entries (message) (let ((method (find message (sod-class-effective-methods subclass) :key #'effective-method-message))) - (make-method-entry method chain-head chain-tail)))) + (make-method-entries method chain-head chain-tail)))) (make-instance 'vtmsgs :class class :subclass subclass :chain-head chain-head :chain-tail chain-tail - :entries (mapcar #'make-entry + :entries (mapcan #'make-entries (sod-class-messages class))))) ;;; class-pointer