- `(multiple-value-bind (result-a result-b valid-p)
- (%invoke-type-method ',(class-function-slot-or-lose simple)
- ',(class-function-slot-or-lose
- (if complex-arg1-p
- complex-arg1
- complex-arg2))
- ',(class-function-slot-or-lose complex-arg2)
- ,complex-arg1-p
- ,type1
- ,type2)
- (if valid-p
- (values result-a result-b)
- ,default)))
-
-;;; most of the implementation of !INVOKE-TYPE-METHOD
+ (let ((simple (class-fun-slot-or-lose simple))
+ (cslot1 (class-fun-slot-or-lose
+ (if complex-arg1-p complex-arg1 complex-arg2)))
+ (cslot2 (class-fun-slot-or-lose complex-arg2)))
+ (once-only ((ntype1 type1)
+ (ntype2 type2))
+ (once-only ((class1 `(type-class-info ,ntype1))
+ (class2 `(type-class-info ,ntype2)))
+ `(if (eq ,class1 ,class2)
+ (funcall (,simple ,class1) ,ntype1 ,ntype2)
+ ,(once-only ((complex2 `(,cslot2 ,class2)))
+ `(if ,complex2
+ (funcall ,complex2 ,ntype1 ,ntype2)
+ ,(once-only ((complex1 `(,cslot1 ,class1)))
+ `(if ,complex1
+ (if ,complex-arg1-p
+ (funcall ,complex1 ,ntype1 ,ntype2)
+ (funcall ,complex1 ,ntype2 ,ntype1))
+ ,default)))))))))
+
+;;; This is a very specialized implementation of CLOS-style
+;;; CALL-NEXT-METHOD within our twisty little type class object
+;;; system, which works given that it's called from within a
+;;; COMPLEX-SUBTYPEP-ARG2 method. (We're particularly motivated to
+;;; implement CALL-NEXT-METHOD in that case, because ANSI imposes some
+;;; strict limits on when SUBTYPEP is allowed to return (VALUES NIL NIL),
+;;; so instead of just complacently returning (VALUES NIL NIL) from a
+;;; COMPLEX-SUBTYPEP-ARG2 method we usually need to CALL-NEXT-METHOD.)