(in-package "SB-PCL")
\f
-(defmethod shared-initialize :after ((slotd standard-slot-definition)
- slot-names &key)
- (declare (ignore slot-names))
- (with-slots (allocation class)
- slotd
- (setq allocation (if (eq allocation :class) class allocation))))
-
-(defmethod shared-initialize :after ((slotd structure-slot-definition)
- slot-names
- &key (allocation :instance))
- (declare (ignore slot-names))
- (unless (eq allocation :instance)
- (error "Structure slots must have :INSTANCE allocation.")))
-
-(defmethod inform-type-system-about-class ((class structure-class) (name t))
- nil)
;;; methods
;;;
t)))
#'(lambda (&rest args) (funcall mf args nil))))
+
+(defun error-need-at-least-n-args (function n)
+ (error "~@<The function ~2I~_~S ~I~_requires at least ~D argument~:P.~:>"
+ function
+ n))
+
(defun types-from-arguments (generic-function arguments
&optional type-modifier)
(multiple-value-bind (nreq applyp metatypes nkeys arg-info)
(dotimes-fixnum (i nreq)
i
(unless arguments
- (error "The function ~S requires at least ~D arguments"
- (generic-function-name generic-function)
- nreq))
+ (error-need-at-least-n-args (generic-function-name generic-function)
+ nreq))
(let ((arg (pop arguments)))
(push (if type-modifier `(,type-modifier ,arg) arg) types-rev)))
(values (nreverse types-rev) arg-info))))