class)
(dolist (slot slots)
(unless (eq (getf slot :allocation :instance) :instance)
- (error "Slot allocation ~S is not supported in bootstrap.")))
+ (error "Slot allocation ~S is not supported in bootstrap."
+ (getf slot :allocation))))
(when (typep wrapper 'wrapper)
(setf (wrapper-instance-slots-layout wrapper)
structure-class condition-class
slot-class std-class))
(set-slot 'direct-slots direct-slots)
- (set-slot 'slots slots)
- (set-slot 'initialize-info nil))
+ (set-slot 'slots slots))
;; For all direct superclasses SUPER of CLASS, make sure CLASS is
;; a direct subclass of SUPER. Note that METACLASS-NAME doesn't
(setq *boot-state* 'braid)
(defmethod no-applicable-method (generic-function &rest args)
- (error "~@<There is no matching method for the generic function ~2I~_~S~
+ (error "~@<There is no applicable method for the generic function ~2I~_~S~
~I~_when called with arguments ~2I~_~S.~:>"
generic-function
args))
~I~_when called with arguments ~2I~_~S.~:>"
generic-function
args))
+
+(defmethod invalid-qualifiers ((gf generic-function)
+ combin
+ method)
+ (let ((qualifiers (method-qualifiers method)))
+ (let ((why (cond
+ ((cdr qualifiers) "has too many qualifiers")
+ (t (aver (not (member (car qualifiers)
+ '(:around :before :after))))
+ "has an invalid qualifier"))))
+ (invalid-method-error
+ method
+ "The method ~S on ~S ~A.~%~
+ Standard method combination requires all methods to have one~%~
+ of the single qualifiers :AROUND, :BEFORE and :AFTER or to~%~
+ have no qualifier at all."
+ method gf why))))