(eq (pop specls) *the-class-t*))
(every #'classp specls))
(cond ((and (eq (class-name (car specls)) 'std-class)
- (eq (class-name (cadr specls)) 'std-object)
+ (eq (class-name (cadr specls)) 'standard-object)
(eq (class-name (caddr specls))
'standard-effective-slot-definition))
(set-standard-svuc-method type method))
precompute-p
(not (or (eq spec *the-class-t*)
(eq spec *the-class-slot-object*)
- (eq spec *the-class-std-object*)
(eq spec *the-class-standard-object*)
(eq spec *the-class-structure-object*)))
(let ((sc (class-direct-subclasses spec)))
cache)))
(defmacro class-test (arg class)
- (cond ((eq class *the-class-t*)
- t)
- ((eq class *the-class-slot-object*)
- `(not (typep (classoid-of ,arg)
- 'built-in-classoid)))
- ((eq class *the-class-std-object*)
- `(or (std-instance-p ,arg) (fsc-instance-p ,arg)))
- ((eq class *the-class-standard-object*)
- `(std-instance-p ,arg))
- ((eq class *the-class-funcallable-standard-object*)
- `(fsc-instance-p ,arg))
- (t
- `(typep ,arg ',(class-name class)))))
+ (cond
+ ((eq class *the-class-t*) t)
+ ((eq class *the-class-slot-object*)
+ `(not (typep (classoid-of ,arg) 'built-in-classoid)))
+ ((eq class *the-class-standard-object*)
+ `(or (std-instance-p ,arg) (fsc-instance-p ,arg)))
+ ((eq class *the-class-funcallable-standard-object*)
+ `(fsc-instance-p ,arg))
+ (t
+ `(typep ,arg ',(class-name class)))))
(defmacro class-eq-test (arg class)
`(eq (class-of ,arg) ',class))
(defun generate-discrimination-net (generic-function methods types sorted-p)
(let* ((arg-info (gf-arg-info generic-function))
- (c-a-m-emf-std-p (gf-info-c-a-m-emf-std-p arg-info))
+ (c-a-m-emf-std-p (gf-info-c-a-m-emf-std-p arg-info))
(precedence (arg-info-precedence arg-info)))
(generate-discrimination-net-internal
generic-function methods types
(lambda (methods known-types)
(if (or sorted-p
- (and c-a-m-emf-std-p
- (block one-order-p
- (let ((sorted-methods nil))
- (map-all-orders
- (copy-list methods) precedence
- (lambda (methods)
- (when sorted-methods (return-from one-order-p nil))
- (setq sorted-methods methods)))
- (setq methods sorted-methods))
- t)))
+ (and c-a-m-emf-std-p
+ (block one-order-p
+ (let ((sorted-methods nil))
+ (map-all-orders
+ (copy-list methods) precedence
+ (lambda (methods)
+ (when sorted-methods (return-from one-order-p nil))
+ (setq sorted-methods methods)))
+ (setq methods sorted-methods))
+ t)))
`(methods ,methods ,known-types)
`(unordered-methods ,methods ,known-types)))
(lambda (position type true-value false-value)
(make-dfun-lambda-list metatypes applyp)
(make-fast-method-call-lambda-list metatypes applyp))))
(multiple-value-bind (cfunction constants)
- (get-fun1 `(,(if function-p
- 'instance-lambda
- 'lambda)
+ (get-fun1 `(lambda
,arglist
,@(unless function-p
`((declare (ignore .pv-cell.