(when restp
`(&rest ,(intern "Discriminating Function &rest Arg")))))
\f
+(defmethod generic-function-argument-precedence-order
+ ((gf standard-generic-function))
+ (aver (eq *boot-state* 'complete))
+ (loop with arg-info = (gf-arg-info gf)
+ with lambda-list = (arg-info-lambda-list arg-info)
+ for argument-position in (arg-info-precedence arg-info)
+ collect (nth argument-position lambda-list)))
+
(defmethod generic-function-lambda-list ((gf generic-function))
(gf-lambda-list gf))
(defun compute-applicable-methods-function (generic-function arguments)
(values (compute-applicable-methods-using-types
generic-function
- (types-from-arguments generic-function arguments 'eql))))
+ (types-from-args generic-function arguments 'eql))))
(defmethod compute-applicable-methods
((generic-function generic-function) arguments)
(values (compute-applicable-methods-using-types
generic-function
- (types-from-arguments generic-function arguments 'eql))))
+ (types-from-args generic-function arguments 'eql))))
(defmethod compute-applicable-methods-using-classes
((generic-function generic-function) classes)
(compute-applicable-methods-using-types
generic-function
- (types-from-arguments generic-function classes 'class-eq)))
+ (types-from-args generic-function classes 'class-eq)))
(defun proclaim-incompatible-superclasses (classes)
(setq classes (mapcar (lambda (class)
function
n))
-(defun types-from-arguments (generic-function arguments
- &optional type-modifier)
+(defun types-from-args (generic-function arguments &optional type-modifier)
(multiple-value-bind (nreq applyp metatypes nkeys arg-info)
(get-generic-fun-info generic-function)
(declare (ignore applyp metatypes nkeys))
meth generic-function))))
(cddr form)))
(default (car (last list))))
- (list (list* ':mcase mp (nbutlast list))
+ (list (list* :mcase mp (nbutlast list))
(cdr default))))
(t
(default-constant-converter form))))))
(defun convert-table (constant method-alist wrappers)
(cond ((and (consp constant)
- (eq (car constant) ':mcase))
+ (eq (car constant) :mcase))
(let ((alist (mapcar (lambda (k+m)
(cons (car k+m)
(convert-methods (cdr k+m)
(format t "~&make-unordered-methods-emf ~S~%"
(generic-function-name generic-function)))
(lambda (&rest args)
- (let* ((types (types-from-arguments generic-function args 'eql))
+ (let* ((types (types-from-args generic-function args 'eql))
(smethods (sort-applicable-methods generic-function
methods
types))