From: Mark Wooding Date: Sun, 30 Aug 2015 09:58:38 +0000 (+0100) Subject: src/class-make-impl.lisp: Make `make-sod-MUMBLE' actually return a MUMBLE. X-Git-Tag: 0.2.0~15 X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/commitdiff_plain/2e1a785d73494fd7adb8573bed52d7c1d50643d5?ds=inline src/class-make-impl.lisp: Make `make-sod-MUMBLE' actually return a MUMBLE. --- diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index 32b2e61..f9d5734 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.lisp @@ -87,7 +87,8 @@ (defmethod make-sod-slot :location (file-location location) :pset pset))) (with-slots (slots) class - (setf slots (append slots (list slot))))))) + (setf slots (append slots (list slot)))) + slot))) (defmethod shared-initialize :after ((slot sod-slot) slot-names &key pset) "This method does nothing. @@ -111,7 +112,8 @@ (defmethod make-sod-instance-initializer (file-location location)))) (with-slots (instance-initializers) class (setf instance-initializers - (append instance-initializers (list initializer))))))) + (append instance-initializers (list initializer)))) + initializer))) (defmethod make-sod-class-initializer ((class sod-class) nick name value-kind value-form pset @@ -124,7 +126,8 @@ (defmethod make-sod-class-initializer (file-location location)))) (with-slots (class-initializers) class (setf class-initializers - (append class-initializers (list initializer))))))) + (append class-initializers (list initializer)))) + initializer))) (defmethod make-sod-initializer-using-slot ((class sod-class) (slot sod-slot) @@ -163,7 +166,8 @@ (defmethod make-sod-message :location (file-location location) :pset pset))) (with-slots (messages) class - (setf messages (append messages (list message))))))) + (setf messages (append messages (list message)))) + message))) (defmethod shared-initialize :after ((message sod-message) slot-names &key pset) @@ -188,7 +192,8 @@ (defmethod make-sod-method type body pset (file-location location)))) (with-slots (methods) class - (setf methods (append methods (list method))))))) + (setf methods (append methods (list method)))) + method))) (defmethod make-sod-method-using-message ((message sod-message) (class sod-class) type body pset location)