From a311bb37ceb818f82014b0b7924966523a955922 Mon Sep 17 00:00:00 2001
From: phg <phg>
Date: Mon, 8 Feb 1993 17:32:44 +0000
Subject: [PATCH] Changed definition of *subtypep to speed up method definition
 using code provided by Richard Harris.

---
 pcl/defs.lisp | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)

diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index 348c1f9dc..99a18934c 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -361,22 +361,33 @@
         (t
          (typep object (convert-to-system-type type)))))
 
+;Writing the missing NOT and AND clauses will improve
+;the quality of code generated by generate-discrimination-net, but
+;calling subtypep in place of just returning (values nil nil) can be
+;very slow.  *subtypep is used by PCL itself, and must be fast.
 (defun *subtypep (type1 type2)
   (if (equal type1 type2)
       (values t t)
       (if (eq *boot-state* 'early)
 	  (values (eq type1 type2) t)
-	  (let ((*in-precompute-effective-methods-p* t)) ; not a descriptive name
+	  (let ((*in-precompute-effective-methods-p* t)) 
 	    (declare (special *in-precompute-effective-methods-p*))
-	    ;; This changes the way class-applicable-using-class-p works.
+            ;; *in-precompute-effective-methods-p* is not a good name.
+	    ;; It changes the way class-applicable-using-class-p works.
 	    (setq type1 (*normalize-type type1))
 	    (setq type2 (*normalize-type type2))
-	    (if (member (car type2) '(eql wrapper-eq class-eq class))
-		(multiple-value-bind (app-p maybe-app-p)
-		    (specializer-applicable-using-type-p type2 type1)
-		  (values app-p (or app-p (not maybe-app-p))))
-		(subtypep (convert-to-system-type type1)
-			  (convert-to-system-type type2)))))))
+	    (case (car type2)
+	      (not
+	       (values nil nil)) ; Should improve this.
+	      (and
+	       (values nil nil)) ; Should improve this.
+	      ((eql wrapper-eq class-eq class)
+	       (multiple-value-bind (app-p maybe-app-p)
+		   (specializer-applicable-using-type-p type2 type1)
+		 (values app-p (or app-p (not maybe-app-p)))))
+	      (t
+	       (subtypep (convert-to-system-type type1)
+			 (convert-to-system-type type2))))))))
 
 (defun do-satisfies-deftype (name predicate)
   #+(or :Genera (and :Lucid (not :Prime)) ExCL :coral)
-- 
GitLab