-;;; KLUDGE: This function must be INLINE in order for cold init to
-;;; work, because the first three arguments are TYPE-CLASS structure
-;;; accessor functions whose calls have to be compiled inline in order
-;;; to work in calls to this function early in cold init. So don't
-;;; conditionalize this INLINE declaration with #!-SB-FLUID or
-;;; anything, unless you also rearrange things to cause the full
-;;; function definitions of the relevant structure accessors to be
-;;; available sufficiently early in cold init. -- WHN 19991015
-(declaim (inline %invoke-type-method))
-(defun %invoke-type-method (simple cslot1 cslot2 complex-arg1-p type1 type2)
- (declare (type symbol simple cslot1 cslot2))
- (multiple-value-bind (result-a result-b)
- (let ((class1 (type-class-info type1))
- (class2 (type-class-info type2)))
- (if (eq class1 class2)
- (funcall (funcall simple class1) type1 type2)
- (let ((complex2 (funcall cslot2 class2)))
- (if complex2
- (funcall complex2 type1 type2)
- (let ((complex1 (funcall cslot1 class1)))
- (if complex1
- (if complex-arg1-p
- (funcall complex1 type1 type2)
- (funcall complex1 type2 type1))
- ;; No meaningful result was found: the caller should
- ;; use the default value instead.
- (return-from %invoke-type-method (values nil nil nil))))))))
- ;; If we get to here (without breaking out by calling RETURN-FROM)
- ;; then a meaningful result was found, and we return it.
- (values result-a result-b t)))
+;;; (We miss CLOS! -- CSR and WHN)
+(defun invoke-complex-subtypep-arg1-method (type1 type2 &optional subtypep win)
+ (let* ((type-class (type-class-info type1))
+ (method-fun (type-class-complex-subtypep-arg1 type-class)))
+ (if method-fun
+ (funcall (the function method-fun) type1 type2)
+ (values subtypep win))))
+
+;;; KLUDGE: This function is dangerous, as its overuse could easily
+;;; cause stack exhaustion through unbounded recursion. We only use
+;;; it in one place; maybe it ought not to be a function at all?
+(defun invoke-complex-=-other-method (type1 type2)
+ (let* ((type-class (type-class-info type1))
+ (method-fun (type-class-complex-= type-class)))
+ (if method-fun
+ (funcall (the function method-fun) type2 type1)
+ (values nil t))))