src/class-make-{proto,impl}.lisp: Don't make duplicate initargs.

If you set an initarg property on a slot definition which includes an
initializer then both the slot definition and the initializer act on the
initarg property and you end up with two initargs.  This isn't actually
a major problem, but it's ugly.

Add a new keyword argument to `make-sod-instance-initializer' to prevent
this from happening.

diff --git a/doc/meta.tex b/doc/meta.tex
index 2d1a577a24bd72d69bb0ad7159d984c6c6b865b1..4b42a86f24e479f4b24b5fdf6e31b6dd8f07de7e 100644 (file)
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -166,7 +166,8 @@
 \begin{describe*}
     {\dhead{gf}
       {make-sod-instance-initializer
-          \=@<class> @<nick> @<name> @<value> @<pset> \&key :location
+          \=@<class> @<nick> @<name> @<value> @<pset> \\
+          \>\&key :inhibit-initargs :location
         \nlret @<init>}
      \dhead{gf}
       {make-sod-class-initializer

diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index 5fe9de762c40d5b63b86bc5e1a1332f5e46d2ecc..4785d9c603531ac489bc60c61e3ae3e168fe9f38 100644 (file)
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -115,7 +115,7 @@ (defmethod shared-initialize :after ((slot sod-slot) slot-names &key pset)
 ;;; 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 @@ (defmethod make-sod-instance-initializer
       (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

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index a2783ee81d92085e17280086927ef848c5399b99..5622dc6fb5195963c6565f1aedbe697b13ffeda6 100644 (file)
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -86,7 +86,7 @@ (defgeneric make-sod-slot (class name type pset &key location)
 
 (export 'make-sod-instance-initializer)
 (defgeneric make-sod-instance-initializer
-    (class nick name value pset &key location)
+    (class nick name value pset &key location inhibit-initargs)
   (:documentation
    "Construct and attach an instance slot initializer, to CLASS.
 
@@ -95,7 +95,13 @@ (defgeneric make-sod-instance-initializer
    construction process.  The default method looks up the slot using
    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list
-   in CLASS."))
+   in CLASS.
+
+   Usually, if an `initarg' property is set on PSET, then a slot initarg is
+   created and attached to the slot; this can be prevented by setting
+   INHIBIT-INITARGS non-nil.  This is needed when creating a slot and
+   initializer from the same property set, in order to prevent creation of a
+   duplicate initarg."))
 
 (export 'make-sod-class-initializer)
 (defgeneric make-sod-class-initializer