X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/81054f0131824964d2cebfd7dec6f18be113020b..12a6d10db2263d22c743939a08ab3d60f67fc2b2:/src/class-make-impl.lisp diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index 5fe9de7..b96d830 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.lisp @@ -115,7 +115,7 @@ ;;; Slot initializers. (defmethod make-sod-instance-initializer - ((class sod-class) nick name value pset &key location) + ((class sod-class) nick name value pset &key location inhibit-initargs) (with-default-error-location (location) (let* ((slot (find-instance-slot-by-name class nick name)) (initarg-name (get-property pset :initarg :id)) @@ -126,7 +126,7 @@ (with-slots (instance-initializers) class (unless (or initarg-name initializer) (error "Slot initializer declaration with no effect")) - (when initarg-name + (when (and initarg-name (not inhibit-initargs)) (make-sod-slot-initarg-using-slot class initarg-name slot pset :location location)) (when initializer @@ -183,11 +183,15 @@ ((class sod-class) name (slot sod-slot) pset &key location) (with-slots (initargs) class (with-slots ((type %type)) slot - (push (make-instance (get-property pset :initarg-class :symbol - 'sod-slot-initarg) - :location (file-location location) - :class class :name name :type type :slot slot) - initargs)))) + (setf initargs + (append initargs + (cons (make-instance (get-property pset :initarg-class + :symbol + 'sod-slot-initarg) + :location (file-location location) + :class class :name name + :type type :slot slot) + nil)))))) (defmethod sod-initarg-default ((initarg sod-initarg)) nil)