From 01e975ab7a97392b2a52cf5c1be8572923d312c1 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 19 Jun 1997 20:12:30 +0000
Subject: [PATCH] SUBCLASS? must allow its second argument to be any
 specializer.

---
 v7/src/sos/class.scm | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/v7/src/sos/class.scm b/v7/src/sos/class.scm
index b0ce8712f..bd5b4d9ab 100644
--- a/v7/src/sos/class.scm
+++ b/v7/src/sos/class.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: class.scm,v 1.2 1997/06/04 22:29:00 cph Exp $
+;;; $Id: class.scm,v 1.3 1997/06/19 20:12:30 cph Exp $
 ;;;
 ;;; Copyright (c) 1995-97 Massachusetts Institute of Technology
 ;;;
@@ -112,16 +112,17 @@
   (class/dispatch-tag class))
 
 (define (subclass? c1 c2)
-  ;; A union specializer can't be a subclass of anything, but a class
-  ;; can be a subclass of a union specializer.
   (guarantee-class c1 'SUBCLASS?)
-  (if (union-specializer? c2)
-      (there-exists? (union-specializer-classes c2)
-	(lambda (c2)
-	  (memq c2 (class/precedence-list c1))))
-      (begin
-	(guarantee-class c2 'SUBCLASS?)
-	(memq c2 (class/precedence-list c1)))))
+  (cond ((class? c2)
+	 (memq c2 (class/precedence-list c1)))
+	((record-type? c2)
+	 (memq (record-type-class c2) (class/precedence-list c1)))
+	((union-specializer? c2)
+	 (there-exists? (union-specializer-classes c2)
+	   (lambda (c2)
+	     (memq c2 (class/precedence-list c1)))))
+	(else
+	 (error:wrong-type-argument c2 "specializer" 'SUBCLASS?))))
 
 (define (guarantee-class class name)
   (if (not (class? class))
-- 
2.25.1