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