Comment 3 for bug 309072

Roman Brenes (roman-brenes) wrote :

Nikodemus, thanks for pointing me in the right direction. Here's a new patch for this bug along with my rationale for it, given that it is a compliance bug. Unfortunately the patch has a rather drastic effect on performance (see timing at the end) so you might want to keep it on the back burner. Any suggestions welcome.

dpANS does mentions in section "7.1.6 Initialize-Instance" that:

During initialization, initialize-instance is invoked after the following actions have been taken:
 ...
 * The validity of the defaulted initialization argument list has been checked. If any of the initialization arguments has not been declared as valid, an error is signaled.
 ...

But, on reading section "7.1.2 Declaring the Validity of Initialization Arguments" it seems that the narrow definition of the term "valid" applies to a different context and might not apply to the checks of the :NAME argument as required by the MOP for slot-definition initialization. If this is indeed the case, then as previously suggested by you, initialize-instance is a more appropriate method to effect this check than make-instance.

Also, wrt. defining the phrase "a symbol which can be used as a variable name." as mentioned in the text of this bug I could only find http://coding.derkeiler.com/Archive/Lisp/comp.lang.lisp/2006-03/msg00408.html which I have taken to mean that the predicate CONSTANTP will be null for such symbols.

Finally, I was not sure whether the phrasing of the MOP requires the use of "signal" or "error" but, I opted for "error" as otherwise if *break-on-signal* is null the restrictions of the MOP are silently ignored which didn't seem appropriate.

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index a4c3dad..809c04f 100644
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -56,6 +56,14 @@
         finally
           (return (append supplied-initargs default-initargs))))

+(defmethod initialize-instance :before ((class slot-definition) &rest initargs)
+ (let* ((name-arg (member :name initargs :test #'eq))
+ (name-value (cadr name-arg)))
+ (unless name-arg
+ (error "INITIALIZE-INSTANCE (SLOT-DEFINITION) requires a :NAME argument (see AMOP chapter 6)"))
+ (if (constantp name-value)
+ (error "INITIALIZE-INSTANCE (SLOT-DEFINITION) disallows a named constant/defconstant as the value of :NAME but was given ~S (see AMOP chapter 6)" name-value))))
+
 (defmethod initialize-instance ((instance slot-object) &rest initargs)
   (apply #'shared-initialize instance t initargs))

========================== Timing on sbcl-1.0.29 =========================
Before defining the :before method

* (time (dotimes (x 100000000) (make-instance 'sb-mop:standard-direct-slot-definition :name 'anonymous)))

Evaluation took:
  19.969 seconds of real time
  19.973249 seconds of total run time (19.725233 user, 0.248016 system)
  [ Run times consist of 2.629 seconds GC time, and 17.345 seconds non-GC time. ]
  100.02% CPU
  39,837,001,524 processor cycles
  14,399,961,184 bytes consed

After defining the :before method

* (time (dotimes (x 100000000) (make-instance 'sb-mop:standard-direct-slot-definition :name 'anonymous)))

Evaluation took:
  72.245 seconds of real time
  72.228514 seconds of total run time (71.868492 user, 0.360022 system)
  [ Run times consist of 4.136 seconds GC time, and 68.093 seconds non-GC time. ]
  99.98% CPU
  115 lambdas converted
  144,130,054,404 processor cycles
  22,402,610,784 bytes consed