X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/aa14a4cddcb96b681d5c19a2ec8bad382f43b264..52a79ab8b310a785f2c2f1a11069f3a5ad53810c:/src/class-make-impl.lisp diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index 4470416..1daab39 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.lisp @@ -79,7 +79,7 @@ (defmethod make-sod-slot ((class sod-class) name type pset &optional location) (with-default-error-location (location) - (let ((slot (make-instance (get-property pset :lisp-class :symbol + (let ((slot (make-instance (get-property pset :slot-class :symbol 'sod-slot) :class class :name name @@ -87,8 +87,7 @@ :location (file-location location) :pset pset))) (with-slots (slots) class - (setf slots (append slots (list slot)))) - (check-unused-properties pset)))) + (setf slots (append slots (list slot))))))) (defmethod shared-initialize :after ((slot sod-slot) slot-names &key pset) "This method does nothing. @@ -112,8 +111,7 @@ (file-location location)))) (with-slots (instance-initializers) class (setf instance-initializers - (append instance-initializers (list initializer)))) - (check-unused-properties pset)))) + (append instance-initializers (list initializer))))))) (defmethod make-sod-class-initializer ((class sod-class) nick name value-kind value-form pset @@ -126,13 +124,12 @@ (file-location location)))) (with-slots (class-initializers) class (setf class-initializers - (append class-initializers (list initializer)))) - (check-unused-properties pset)))) + (append class-initializers (list initializer))))))) (defmethod make-sod-initializer-using-slot ((class sod-class) (slot sod-slot) init-class value-kind value-form pset location) - (make-instance (get-property pset :lisp-class :symbol init-class) + (make-instance (get-property pset :initializer-class :symbol init-class) :class class :slot slot :value-kind value-kind @@ -155,7 +152,7 @@ (defmethod make-sod-message ((class sod-class) name type pset &optional location) (with-default-error-location (location) - (let ((message (make-instance (get-property pset :lisp-class :symbol + (let ((message (make-instance (get-property pset :message-class :symbol 'standard-message) :class class :name name @@ -163,8 +160,7 @@ :location (file-location location) :pset pset))) (with-slots (messages) class - (setf messages (append messages (list message)))) - (check-unused-properties pset)))) + (setf messages (append messages (list message))))))) (defmethod shared-initialize :after ((message sod-message) slot-names &key pset) @@ -189,12 +185,11 @@ type body pset (file-location location)))) (with-slots (methods) class - (setf methods (append methods (list method))))) - (check-unused-properties pset))) + (setf methods (append methods (list method))))))) (defmethod make-sod-method-using-message ((message sod-message) (class sod-class) type body pset location) - (make-instance (or (get-property pset :lisp-class :symbol) + (make-instance (or (get-property pset :method-class :symbol) (sod-message-method-class message class pset)) :message message :class class @@ -215,7 +210,10 @@ ;; Check that the arguments are named if we have a method body. (with-slots (body type) method (unless (or (not body) - (every #'argument-name (c-function-arguments type))) + (every (lambda (arg) + (or (argument-name arg) + (eq (argument-type arg) (c-type void)))) + (c-function-arguments type))) (error "Abstract declarators not permitted in method definitions"))) ;; Check the method type.