;; We still need to deal with the class case too, but at
;; least #.(find-class 'integer) and integer as equivalent
;; specializers with this.
- (let* ((specializer (if (and (typep specializer 'class)
- (let ((name (class-name specializer)))
- (and name (symbolp name)
- (eq specializer (find-class name nil)))))
- (class-name specializer)
- specializer))
- (kind (info :type :kind specializer)))
-
- (flet ((specializer-class ()
- (if (typep specializer 'class)
- specializer
- (find-class specializer nil))))
+ (let* ((specializer-nameoid
+ (if (and (typep specializer 'class)
+ (let ((name (class-name specializer)))
+ (and name (symbolp name)
+ (eq specializer (find-class name nil)))))
+ (class-name specializer)
+ specializer))
+ (kind (info :type :kind specializer-nameoid)))
+
+ (flet ((specializer-nameoid-class ()
+ (typecase specializer-nameoid
+ (symbol (find-class specializer-nameoid nil))
+ (class specializer-nameoid)
+ (class-eq-specializer
+ (specializer-class specializer-nameoid))
+ (t nil))))
(ecase kind
- ((:primitive) `(type ,specializer ,parameter))
+ ((:primitive) `(type ,specializer-nameoid ,parameter))
((:defined)
- (let ((class (specializer-class)))
- ;; CLASS can be null here if the user has erroneously
- ;; tried to use a defined type as a specializer; it
- ;; can be a non-BUILT-IN-CLASS if the user defines a
- ;; type and calls (SETF FIND-CLASS) in a consistent
- ;; way.
+ (let ((class (specializer-nameoid-class)))
+ ;; CLASS can be null here if the user has
+ ;; erroneously tried to use a defined type as a
+ ;; specializer; it can be a non-BUILT-IN-CLASS if
+ ;; the user defines a type and calls (SETF
+ ;; FIND-CLASS) in a consistent way.
(when (and class (typep class 'built-in-class))
- `(type ,specializer ,parameter))))
+ `(type ,specializer-nameoid ,parameter))))
((:instance nil)
- (let ((class (specializer-class)))
+ (let ((class (specializer-nameoid-class)))
(cond
(class
(if (typep class '(or built-in-class structure-class))
- `(type ,specializer ,parameter)
+ `(type ,class ,parameter)
;; don't declare CLOS classes as parameters;
;; it's too expensive.
'(ignorable)))
;; ...)). Best to let the user know we haven't
;; been able to extract enough information:
(style-warn
- "~@<can't find type for presumed class ~S in ~S.~@:>"
- specializer
+ "~@<can't find type for specializer ~S in ~S.~@:>"
+ specializer-nameoid
'parameter-specializer-declaration-in-defmethod)
'(ignorable)))))
((:forthcoming-defclass-type)
(t form))))
(let ((walked-lambda (walk-form method-lambda env #'walk-function)))
- (values walked-lambda
+ ;;; FIXME: the walker's rewriting of the source code causes
+ ;;; trouble when doing code coverage. The rewrites should be
+ ;;; removed, and the same operations done using
+ ;;; compiler-macros or tranforms.
+ (values (if (sb-c:policy env (= sb-c:store-coverage-data 0))
+ walked-lambda
+ method-lambda)
call-next-method-p
closurep
next-method-p-p
(setf (gf-dfun-state generic-function) new-value)))
(defun set-dfun (gf &optional dfun cache info)
- (when cache
- (setf (cache-owner cache) gf))
(let ((new-state (if (and dfun (or cache info))
(list* dfun cache info)
dfun)))