+ (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.)
+;;;
+;;; KLUDGE: In CLOS, this could just be CALL-NEXT-METHOD and
+;;; everything would Just Work without us having to think about it. In
+;;; our goofy type dispatch system, it's messier to express. It's also
+;;; more fragile, since (0) there's no check that it's called from
+;;; within a COMPLEX-SUBTYPEP-ARG2 method as it should be, and (1) we
+;;; rely on our global knowledge that the next (and only) relevant
+;;; method is COMPLEX-SUBTYPEP-ARG1, and (2) we rely on our global
+;;; knowledge of the appropriate default for the CSUBTYPEP function
+;;; when no next method exists. -- WHN 2002-04-07