-;This stuff isn't right. Good thing it isn't used.
-;The satisfies predicate has to be a symbol. There is no way to
-;construct such a symbol from a class object if class names change.
-(defun class-predicate (class)
- (when (symbolp class) (setq class (find-class class)))
- #'(lambda (object) (memq class (class-precedence-list (class-of object)))))
-
-(defun make-class-eq-predicate (class)
- (when (symbolp class) (setq class (find-class class)))
- #'(lambda (object) (eq class (class-of object))))
-
-(defun make-eql-predicate (eql-object)
- #'(lambda (object) (eql eql-object object)))
-
-#|| ; The argument to satisfies must be a symbol.
-(deftype class (&optional class)
- (if class
- `(satisfies ,(class-predicate class))
- `(satisfies ,(class-predicate 'class))))
-
-(deftype class-eq (class)
- `(satisfies ,(make-class-eq-predicate class)))
-||#
+(defun make-type-predicate-name (name &optional kind)
+ (if (symbol-package name)
+ (intern (format nil
+ "~@[~A ~]TYPE-PREDICATE ~A ~A"
+ kind
+ (package-name (symbol-package name))
+ (symbol-name name))
+ *pcl-package*)
+ (make-symbol (format nil
+ "~@[~A ~]TYPE-PREDICATE ~A"
+ kind
+ (symbol-name name)))))