(let ((fmf (slot-value method 'fast-function)))
(unless fmf ; The :BEFORE SHARED-INITIALIZE method prevents this.
(error "~S doesn't seem to have a METHOD-FUNCTION." method))
(let ((fmf (slot-value method 'fast-function)))
(unless fmf ; The :BEFORE SHARED-INITIALIZE method prevents this.
(error "~S doesn't seem to have a METHOD-FUNCTION." method))
(method-function-from-fast-function fmf)))))
(defmethod accessor-method-class ((method standard-accessor-method))
(method-function-from-fast-function fmf)))))
(defmethod accessor-method-class ((method standard-accessor-method))
(error 'metaobject-initialization-violation
:format-control ,(format nil "~@<~A~@:>" control)
:format-arguments (list ',name)
(error 'metaobject-initialization-violation
:format-control ,(format nil "~@<~A~@:>" control)
:format-arguments (list ',name)
(def reinitialize-instance ((method method) &rest initargs)
"Method objects cannot be redefined by ~S.")
(def change-class ((method method) new &rest initargs)
"Method objects cannot be redefined by ~S.")
(def reinitialize-instance ((method method) &rest initargs)
"Method objects cannot be redefined by ~S.")
(def change-class ((method method) new &rest initargs)
"Method objects cannot be redefined by ~S.")
(def update-instance-for-redefined-class ((method method) added discarded
plist &rest initargs)
"No behaviour specified for ~S on method objects.")
(def update-instance-for-redefined-class ((method method) added discarded
plist &rest initargs)
"No behaviour specified for ~S on method objects.")
- (when (and slot-definition (null slot-name))
- (setq slot-name (slot-definition-name slot-definition)))))
+ (when (and %slot-definition (null slot-name))
+ (setq slot-name (slot-definition-name %slot-definition)))))
; :argument-precedence-order
; 'argument-precedence-order)
; (add-initarg declarations :declarations 'declarations)
; :argument-precedence-order
; 'argument-precedence-order)
; (add-initarg declarations :declarations 'declarations)
(defun value-for-caching (gf classes)
(let ((methods (compute-applicable-methods-using-types
gf (mapcar #'class-eq-type classes))))
(defun value-for-caching (gf classes)
(let ((methods (compute-applicable-methods-using-types
gf (mapcar #'class-eq-type classes))))
- (method-function-get (or (method-fast-function (car methods))
- (method-function (car methods)))
+ (method-function-get (or (safe-method-fast-function (car methods))
+ (safe-method-function (car methods)))
(let ((classoid (%wrapper-classoid (class-wrapper class))))
(setf (classoid-name classoid) new-value))
(let ((classoid (%wrapper-classoid (class-wrapper class))))
(setf (classoid-name classoid) new-value))
-(defun (setf generic-function-name) (new-value generic-function)
- (reinitialize-instance generic-function :name new-value))
+(defmethod (setf generic-function-name) (new-value generic-function)
+ (reinitialize-instance generic-function :name new-value)
+ new-value)
\f
(defmethod function-keywords ((method standard-method))
(multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords)
\f
(defmethod function-keywords ((method standard-method))
(multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords)